Fehler Objekt erforderlich

Sub SeparierenInMappe()
Dim v, D As Object, wb As Workbook
Application.ScreenUpdating = False
Set D = CreateObject("scripting.dictionary")
With Tabelle1 'ggf. ANPASSEN !!!!
If .AutoFilterMode Then .AutoFilterMode = False
With .Range("A1").CurrentRegion
For Each v In .Columns(1).Offset(1).Value
If v  "" Then D(v) = 0
Next
For Each v In D.Keys
Set wb = Workbooks.Add(xlWBATWorksheet)
.AutoFilter 1, v
.Copy wb.Worksheets(1).Cells(1)
wb.Worksheets(1).Name = v
wb.SaveAs .Parent.Parent.Path & "\" & v & ".xlsx", xlOpenXMLWorkbook
wb.Close False
Next
.AutoFilter
End With
End With
MsgBox "Finished!"
End Sub