Hallo zusammen,
ich habe ein Makro, welches vollkommen funktionstüchtig ist und es mir erlaubt, eine Tabelle nach gleichen Angaben einer Spalte zu filtern und das Ergebnis in eine neue Arbeitsmappe zu kopieren.
Dies geschieht allerdings ohne die Übernahme von Formeln. Hier wäre ich auf Hilfe angewiesen.
Sub SeparierenInMappe()
Dim v, D As Object, wb As Workbook
Application.ScreenUpdating = False
Set D = CreateObject("scripting.dictionary")
With Tabelle2
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 = "akt. Sortimentsliste"
.PageSetup.Zoom = False
.PageSetup.FitToPagesTall = 1
.PageSetup.FitToPagesWide = 1
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 8
.UsedRange.EntireColumn.AutoFit
End With
wb.SaveAs .Parent.Parent.Path & "\" & v & "_Sortimentsliste.xlsx", xlOpenXMLWorkbook
wb.Close False
Next
.AutoFilter
End With
End With
MsgBox "Finished!"
End Sub
Ich freue mich auf eure Vorschläge.
|