habe folgendes Problem. Ich erhalte oft große Dateien (>60.000 Zeilen), welche ich dann anhand eines Spaltenkriteriums aufteilen muss. Oft verändern sich innerhalb der Dateien die zum aufteilen relevanten Spalten zum aufteilen. Ich habe bereits ein Makro (hier aus dem Forum...Danke dafür), welches nach der Spalte A aufteilt. Ich habe versucht dieses Makro umzuschreiben und jeweils auf die Datei in Hinsicht auf relevante Spalte anzupassen. Dieses Makro behält in der neuen Ausgabe Datei immer die erste Zeile als Kopfzeile bei. Auch hier habe ich das Problem, dass dies je nach Datenlieferung von Datei zu Datei unterschiedlich ist.
Hier zunächst das Makro:
Sub splitten_2()
Dim wbMappe As Workbook, _
wbMappeNeu As Workbook, _
lngZeile As Long, lngZeile1 As Long, _
strPfad As String, lngFileFormat As Long, StatusCalc As Long
'Objektvariablen für die involverten Tabellenblätter
Dim wks_Q As Worksheet, wks_Muster As Worksheet, wks_Z As Worksheet
Dim varWert As Variant 'Merker für Wert in Spalte A
'Pfad festlegen (mit "\")
strPfad = "C:\Temp\"
lngFileFormat = ActiveWorkbook.FileFormat 'Dateiformat der aktuellen Mappe merken
'Makrobremsen lösen
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Erstmal alles in eine neue Mappe temporäre schaufeln
ActiveSheet.Copy
Set wbMappe = ActiveWorkbook
Set wks_Q = wbMappe.Worksheets(1) 'Tabellenblatt mit den Quelldaten
'Leeres Mustertabellenblatt erstellen
wks_Q.Copy After:=wks_Q
Set wks_Muster = ActiveSheet
'im Muster alles löschen außer Zeile 1
wks_Muster.UsedRange.Offset(1, 0).EntireRow.Delete
wks_Muster.Name = "Muster"
With wks_Q
lngZeile1 = 2 'Startzeile für kopieren setzen
varWert = .Cells(lngZeile1, 1).Value 'Vergleichswert in Spalte A
For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row + 1 '+ 1 = 1. leere Zeile
If varWert .Cells(lngZeile, 1).Value Then
Application.StatusBar = "Bearbeite Zeile " & lngZeile & " - Wert: " & varWert
'Mustertabellenblatt und Daten kopieren in neue Arbeitsmappe
wks_Muster.Copy
Set wbMappeNeu = ActiveWorkbook
Set wks_Z = wbMappeNeu.Worksheets(1)
wks_Z.Name = CStr(varWert)
.Range(.Cells(lngZeile1, 1), .Cells(lngZeile - 1, 1)).EntireRow.Copy Destination:= _
wks_Z.Cells(2, 1)
Application.DisplayAlerts = False 'gleiche Dateinamen werden überschrieben - _
Testzeile
wbMappeNeu.SaveAs Filename:=strPfad & CStr(varWert), FileFormat:=lngFileFormat
Application.DisplayAlerts = True ' - Testzeile
wbMappeNeu.Close
Set wbMappeNeu = Nothing
Set wks_Z = Nothing
lngZeile1 = lngZeile 'neue Startzeile für Kopieren setzen
varWert = .Cells(lngZeile1, 1).Value 'neuer Vergleichswert in Spalte A
End If
Next lngZeile
End With 'wks_Q
'temporäre Mappe ohne speichern schliessen
wbMappe.Close savechanges:=False
'Makrobremsen zurücksetzen
With Application
.StatusBar = False
.Calculation = StatusCalc
.ScreenUpdating = True
.EnableEvents = True
End With
'Objektvariablen aufräumen
Set wbMappe = Nothing
Set wks_Q = Nothing
Set wks_Muster = Nothing
End Sub
Habe nun als Beipiel folgendes vor:
Splitten nach Spalte Y und nicht A sowie Beibehaltung der erst 11 Zeilen aus der Datenlieferungsdatei.
Vielleicht kann mir jemand helfen. Habe erst mit VBA angefangen und komme einfach nicht weiter.
VG
Dennis