VBA Code Daten Filtern bis Datensatz 59.

Hallo lieber Comunity,
ich habe eine kleine Herausforderung. Wir haben eine riesige xls. Datei welche in verschiedene Bereiche gesplittert werden muss, je nach Suchkriterium,
Wir können in unserem weiterführenden System nur das Format 97-2003 verarbeiten, Problem hier - Daten nur bis 59.999.
Momentan mache ich das noch händisch, sprich:
Suchkriterium 1:
neues wbk, erstmal alle gefilterten da rein, dann weitere Bearbeitung, danach muss die Datei die 300.000 Zeilen hat in eben mind.5 zerlegt werden und neu gespeichert werden. Mit eben Datei 1 Datei 2 Datei 3 usw. Bis alle Daten gespeichert wurden in eben jeweils neue xls. 97-2003 max 59.999 Zeilen.
Habt ihr eine Idee, wie man dies realisieren kann? Die Daten kommen mit unregelmäßiger Größe also mal sind es 100.000 Zeilen mal 300.000 Zeilen.
Ich habe hier schon in einem anderen Forum nachgefragt und einen guten Code als Ansatz erhalten, aber ich komm damit nicht so wirklich weiter.
Das ist mein Ausgangscode wie ich derzeit alle Datein speichere:
ActiveSheet.Range("$A$1:$DA$313225").AutoFilter Field:=7, Criteria1:="Alles zusammen*"
Dim wkb, wkbnew As Workbook
Set wkb = ThisWorkbook
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Set wkbnew = Application.Workbooks.Add
wkbnew.Sheets(1).Paste Destination:=wkbnew.Sheets(1).Range("$A$1")
wkbnew.SaveAs ".....\alles zusammen_heute_" & Format(Now, "DD.MM.YYYY") & ".xls", FileFormat:=xlExcel8
wkbnew.Close
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
With ActiveSheet
If .FilterMode Then .ShowAllData
End With
und diesen Code hat ein User mir geschickt, wenn ich diesen implementiere, schneidet es bei mir jedoch bei der Erstellung der nächsten Datei immer die erste Zeile ab und darüber hinaus speichert es keine neue Datei, sondern will die erste Datei über speichern. Ich weiß, laut User Hilfe anderem Forum dass es nur zwei kleine Details sind, jedoch bin ich hier einfach noch zu unerfahren diese herauszufinden, Kann mir hier jemand helfen?
Sub M_snb()
Sheets.Add , Sheets(Sheets.Count)
For j = 0 To Sheets(1).UsedRange.Rows.Count \ 60000 + 1
Sheets(1).Cells(j * 60000 + 1, 1).Resize(60000, Sheets(1).UsedRange.Columns.Count).Copy Sheets(2).Cells(1)
Sheets(2).Copy
With ActiveWorkbook
.SaveAs "G:\OF\first.xls", 56
.Close
End With
Next
Es soll eben zum Schluss automatisch die entsprechenden Dateien erstellt werden:
Bei 180.000Zeilen eben drei, wobei überall die Zeile eins als Überschrift vorhanden sein muss, da das die Parameter zur Weiterverarbeitung sind.
Danke euch
Isabelle

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sheets(1).Rows(1).Copy Sheets(2).Cells(1, 1) For j = 0 To Sheets(1).UsedRange.Rows.Count \ 60000 + 1 Sheets(1).Cells(j * 60000 + 2, 1).Resize(60000, Sheets(1).UsedRange.Columns.Count).Copy Sheets(2).Cells(2, 1) Sheets(2).Copy With ActiveWorkbook .SaveAs "G:\OF\first" & Format(j + 1, "00") & ".xls", 56 .Close End With

Hallo Daniel,
vielen dank für die schnelle Antwort. Die erste Datei erstellt er jetzt genauso wie ich sie brauche. Er erstellt die erste Datei mit dem Name.. first. Die Ursprungsdatei enthält ja weiterhin Daten, also müsste er die ersten 59.999 löschen und dann die nächste Datei mit der Überschrift wieder erstellen mit dem nächsten Namen bis eben keine Daten mehr da sind und die Ursprungsdatei dann auch löschen. Kann man das irgendwie mit VBA lösen?
Workbooks.Open "Makroordner\grunddatei_" & Format(Now, "DD.MM.YYYY") & ".xlsx"
Sheets.Add , Sheets(Sheets.Count)
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L2").Select
ActiveCell.FormulaR1C1 = "=LÄNGE(K2)"
Range("L2").Select
Range("L2").AutoFill Range("L2:L" & Cells(Rows.Count, 1).End(xlUp).Row)
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M2").Select

Sheets(1).Rows(1).Copy Sheets(2).Cells(1, 1)
For j = 0 To Sheets(1).UsedRange.Rows.Count \ 59999 + 1
Sheets(1).Cells(j * 59999 + 2, 1).Resize(59999, Sheets(1).UsedRange.Columns.Count).Copy Sheets(2).Cells(2, 1)
Sheets(2).Copy
With ActiveWorkbook
.SaveAs "Makroordner\first" & Format(j + 1, "00") & ".xls", 56
.Close
End With
Next
Das ist jetzt mein angepasster Code.
Danke!
Gruß Isabelle

Sub Export() 'unter Anbidnung (Extras, Verweise..) von "Microsoft Scripting Runtime" Dim Z As Range Dim FSO As New FileSystemObject Dim F As TextStream Dim LineZaehler As Long Dim DateiZaehler As Long Const cExportPfad = "C:\Temp\Datei_" Const cLineZaehlerMax = 59999 With Worksheets(1) For Each Z In Range(.Range("A1"), .Cells(Rows.Count, 1).End(xlUp)) If LineZaehler = 0 Then If Not F Is Nothing Then F.Close DateiZaehler = DateiZaehler + 1 Set F = FSO.CreateTextFile(cExportPfad & Format(DateiZaehler, "0000") & ".csv") LineZaehler = cLineZaehlerMax End If F.WriteLine Join(Application.Transpose(Application.Transpose(Z.EntireRow.Range("A1:DA1"))), ";") LineZaehler = LineZaehler - 1 Next End With F.Close End Sub

Sub Export() 'unter Anbidnung (Extras, Verweise..) von "Microsoft Scripting Runtime" Dim Z As Range Dim FSO As New FileSystemObject Dim F As TextStream Dim LineZaehler As Long Dim DateiZaehler As Long Dim ZeilenMax As Long Dim WB As Workbook Const cExportPfad = "C:\Temp\Datei_" With Worksheets(1) ZeilenMax = 59999 If (.Cells(Rows.Count, 1).End(xlUp).Row Mod ZeilenMax)

Beliebteste Forumthreads (12 Monate)

VBA Code Daten Filtern bis Datensatz 59.

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread