Sheet als neue Datei ohne Makros, Laufzeitfehler 9

Sub AEinfügen()
If Len(Dir("C:\ZB Liste Excel", vbDirectory)) = 0 Then
MkDir "C:\ZB Liste Excel"
End If
ActiveSheet.Copy
ActiveWorkbook.SaveAs "C:\ZB Liste Excel\" & Range("B1") & " " & Range("C1") & ".xls"
Dim shpX As Excel.Shape
For Each shpX In ActiveWorkbook.Sheets("Laufliste").Shapes
shpX.Delete
Next
Set VB = Application.VBE.ActiveVBProject
For Each Objekt In ThisWorkbook.VBProject.vbComponents
If Objekt.Type = 1 Then VB.vbComponents.Remove _
VB.vbComponents(Objekt.name)
Next Objekt
Application.DisplayAlerts = False
ActiveWorkbook.Close
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub