Bilder (shapes) kopieren mit xlPaste?

Private Sub Speichern_Click()
Dim wkbNeu As Workbook
Dim wksNeu As Worksheet
Dim strDateiName As String
Dim i As Integer, k As Integer
Dim Objekt As Shape
'Speichername und SpeicherstrPfad abfragen
strDateiName = ThisWorkbook.Path & "\Kopie von " & ThisWorkbook.Name
strDateiName = Application.GetSaveAsFilename(InitialFileName:=strDateiName, _
FileFilter:="Microsoft Excel-Arbeitsmappe (*.  _
_
xls), *.xls")
If strDateiName = "Falsch" Then Exit Sub
Application.ScreenUpdating = False
With Me.Blätter
' Ausgewählte Tabellenblätter in die Neue Mappe kopieren
i = Application.SheetsInNewWorkbook
'Application.SheetsInNewWorkbook = 1
Set wkbNeu = Workbooks.Add(1)
'Application.SheetsInNewWorkbook = i
For i = 0 To .ListCount - 1
If .Selected(i) Then
If k Then wkbNeu.Sheets.Add After:=wksNeu
k = k + 1
Set wksNeu = wkbNeu.Sheets(k)
wksNeu.Name = ThisWorkbook.Sheets(.List(i)).Name
ThisWorkbook.Sheets(.List(i)).UsedRange.Copy
With wksNeu.Cells(1)
.PasteSpecial xlPasteValues        ' übertrtägt Werte
.PasteSpecial xlPasteFormulas      ' überträgt Zellen mit Formeln
.PasteSpecial xlPasteFormats       ' überträgt Formate
.PasteSpecial xlPasteColumnWidths  ' überträgt Spaltenbreite
End With
' Objekte löschen
'With wksNeu
'    For Each Objekt In .Shapes
'        Objekt.Delete
'    Next Objekt
'End With
Application.Goto Reference:=Cells(1)
Application.CutCopyMode = False
End If
Next i
End With
'Neue Mappe Speichern
wkbNeu.SaveAs Filename:=strDateiName
Unload Me
Application.ScreenUpdating = True
End Sub