Separieren in Mappe - Makro
08.05.2020 09:23:29
Noob
vor einiger Zeit habe ich hier ein Makro gefunden, dass SeparierenInMappe heisst.
Bisher hat es auch gut gearbeitet. Allerdings scheint mit der Version 2016 eine Änderung an den Autofiltern vorgenommen worden zu sein.
D.h. die Erzeugung von den einzelnen Dateien funktioniert, allerdings sind immer alle Daten in den Ergebnisdateien enthalten.
Wie muss das Makro abgeändert werden, damit es wieder funktioniert?
Hier das Makro https:\/\/www.herber.de/bbs/user/137362.txt
Oder direkt:
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.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 & "\" & v & ".xlsx", xlOpenXMLWorkbook
wb.Close False
Next
.AutoFilter
End With
End With
MsgBox "Finished!"
End Sub
Anzeige