Sub SeparierenInMappe()
Dim v, D As Object, wb As Workbook
Application.ScreenUpdating = False
Set D = CreateObject("scripting.dictionary")
With Tabelle1
If .AutoFilterMode Then .AutoFilterMode = False
With .Range("A1:R50").CurrentRegion
For Each v In .Columns(5).Offset(1).Value
If v <> "" Then D(v) = 0
Next
For Each v In D.Keys
Set wb = Workbooks.Add(xlWBATWorksheet)
.AutoFilter 5, v
.Copy wb.Sheets(1).Cells(1)
With wb.Sheets(1)
.Name = v
.PageSetup.FitToPagesTall = 1
.PageSetup.FitToPagesWide = 1
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 11
.UsedRange.EntireColumn.AutoFit
End With
wb.SaveAs
.Parent.Parent.Path & "\FK Tools" & "\" & v & ".xlsx", xlOpenXMLWorkbook
wb.Close False
Next
.AutoFilter
End With
End With
MsgBox "Finished!"
End Sub