Automatisierte Ausgabe aus xlsx in csv

Sub Test()
Dim MyDic As Object, rng As Range, Zelle As Range, ws As Worksheet, wb As Workbook
Application.ScreenUpdating = False
Set MyDic = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet
With ws
Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
For Each Zelle In rng.Offset(1, 0)
If MyDic(Zelle.Value) = "" And Not IsEmpty(Zelle) Then
MyDic(Zelle.Value) = 1
rng.AutoFilter field:=1, Criteria1:=Zelle
Set wb = Workbooks.Add
.UsedRange.SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Cells(1, 1)
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Zelle & ".csv", FileFormat:=6
wb.Close False
rng.AutoFilter
End If
Next
End With
Application.ScreenUpdating = True
End Sub