Hallo zusammen,
Ich habe folgendes Makro, das EINE Exceldatei in MEHRERE Dateien aufteilt, immer wenn sich der Wert in Spalte A ändert:
Bsp:
Lieferant Umsatz
Glashütte 3200
Glashütte 4599
Glashütte 6000
Frener 200
Frender 1000
Hauser 5000
Die Exceldatei wird in 3 Dateien gesplittet je Lieferant.
MEINE FRAGE: Wie muss das Makro aussehen, dass die erste Zeile (also meine Überschrift) in jede neue Datei mit übernommen wird?
Danke für eure Hilfe!!
Anbei das Makro
Sub splitten()
Dim wbMappe As Workbook, _
wbMappeAlt As Workbook, _
shBlatt As Worksheet, _
lngZeile As Long, _
strPfad As String
'Pfad festlegen (mit "\")
strPfad = "C:\Temp\"
'Erstmal alles in eine neue Mappe schaufeln
ActiveSheet.UsedRange.Cut
Set wbMappe = Workbooks.Add
wbMappe.Sheets(1).Paste
Application.CutCopyMode = False
Set shBlatt = ActiveSheet
Do
'falls vorhanden, die letzte Mappe speichern + schließen
If Not wbMappeAlt Is Nothing Then
wbMappeAlt.SaveAs Filename:=strPfad & _
CStr(wbMappeAlt.Sheets(1).Cells(1, 1).Value) & ".xls"
wbMappeAlt.Close
Set wbMappeAlt = Nothing
End If
'nächsten Bruch suchen
lngZeile = 1
Do
lngZeile = lngZeile + 1
'wenn Ende, dann Ende
If shBlatt.Cells(lngZeile, 1) = "" Then Exit Do
Loop Until shBlatt.Cells(lngZeile, 1) Cells(lngZeile - 1, 1)
'wenn Ende, dann Ende
If shBlatt.Cells(lngZeile, 1) = "" Then Exit Do
'Rest ausschneiden und in neue Mappe verschieben
Range(shBlatt.Cells(lngZeile, 1), shBlatt.Cells(shBlatt.UsedRange.Rows.Count, _
shBlatt.UsedRange.Columns.Count)).Cut
Set wbMappeAlt = ActiveWorkbook 'Alte Mappe markieren
Set wbMappe = Workbooks.Add
Set shBlatt = wbMappe.Sheets(1)
wbMappe.Sheets(1).Paste
Application.CutCopyMode = False
Loop
'Am Ende die Aktive Mappe speichern und schließen.
ActiveWorkbook.SaveAs Filename:=strPfad & _
CStr(ActiveWorkbook.Sheets(1).Cells(1, 1).Value) & ".xls"
ActiveWorkbook.Close