Macro con la que no puedo guardar la imagen

Esta es la macro que no sé porque no puedo guardar la imagen, ¿alguna solución? ¿Dónde tengo el problema?

Sub AAcopiaImagen()
Dim wsAgenda As Worksheet
Dim wsHoja1 As Worksheet
Dim imgPath As String
Dim imgFileName As String

' Establecer referencias a las hojas
Set wsAgenda = ThisWorkbook.Sheets("Agenda")
Set wsHoja1 = ThisWorkbook.Sheets("Hoja1")

' Limpiar la hoja "Hoja1"
wsHoja1.Cells.Delete

' Definir el rango de la imagen "CDS" en la hoja "Agenda"
wsAgenda.Range("M1:N4").CopyPicture Format:=xlPicture
' Pegar la imagen en la hoja "Hoja1" en el rango A1
wsHoja1.Range("A1").PasteSpecial

' Obtener la ruta de la carpeta "IMG"
imgPath = ThisWorkbook.Path & "\IMG\"

' Crear la carpeta "IMG" si no existe
If Dir(imgPath, vbDirectory) = "" Then
MkDir imgPath
End If

' Eliminar imágenes existentes en la carpeta "IMG"
imgFileName = imgPath & "CDS.jpg"
If Dir(imgFileName) <> "" Then
Kill imgFileName
End If

' Guardar la imagen de la "Hoja1" como un archivo .jpg en la carpeta "IMG"
wsHoja1.Shapes.Item(wsHoja1.Shapes.Count).Copy
wsHoja1.Paste Destination:=wsHoja1.Range("A1")
wsHoja1.Shapes.Item(wsHoja1.Shapes.Count).SaveAsPicture imgFileName

' Limpiar el portapapeles
Application.CutCopyMode = False
End Sub