Tabelle Stückeln und Speichern
04.04.2020 20:11:36
Sonja
ich möchte eine Excelliste nach Abteilungsnamen Stückeln und in einer separaten Datei abspeichern. Ich habe eine Excelliste mit Überschrift und darunter in Spalte A in den Zeilen (ab Zeile2) den Abteilungsnamen und daneben kommen noch weitere Spalten. Wenn der Abteilungsname in Spalte A gleich ist, sollen alle Zeilen und Spalten inkl. der Überschrift in eine separate Datei gespeichert werden mit dem Abteilungsnamen als Dateiname.
Ich habe hier im Forum schon ein Makro gefunden, das prinzipiell funktioniert, nur fehlt mir hier die Überschrift. Könnt ihr mir helfen wie ich noch die Überschrift aus Zeile 1 in die jeweiligen Tabellen bekomme?
Vielen Dank schonmal für eure Hilfe :)
Dies wäre das Makro, wo die Überschirft fehlt:
Sub StückelnSpeichern()
Dim Zelle1 As Range
Dim Zelle2 As Range
Application.ScreenUpdating = False
With ActiveSheet.UsedRange.Columns(1)
.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
Set Zelle1 = .Cells(1, 1)
Do While Zelle1.Value ""
Set Zelle2 = .Find(what:=Zelle1.Value, lookat:=xlWhole, searchdirection:=xlPrevious)
Workbooks.Add
Range(Zelle1, Zelle2).EntireRow.Copy ActiveSheet.Cells(1, 1)
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Zelle1.Value, FileFormat:=51
ActiveWorkbook.Close
Set Zelle1 = Zelle2.Offset(1, 0)
Loop
End With
End Sub