Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.09.2025 18:34:36
Welches Datum gibt mein M-Code aus?
26.09.2025 10:29:46
Wert aus einer Zelle bei jeder Eingabe in neue Zelle
26.09.2025 08:51:00
Teilinhalt einer Zelle vergleichen
25.09.2025 23:04:12
Einen von drei möglichen Einträgen in einer Zeile suchen
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1916to1920
1916to1920
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Datensätze auf mehrere Dateien aufteilen

Forumthread: Datensätze auf mehrere Dateien aufteilen

Datensätze auf mehrere Dateien aufteilen
06.02.2023 10:11:21
Elmar
Hallo Experten,
ich hab das Makro im Forum gefunden und es läuft auch ganz gut, aber eben nur für jeweils einen Datensatz.
Kann mir jemand den Code so anpassen, dass es immer 500 Datensätze kopiert und daraus eine neue Datei macht.
Die Grundtabelle hat über 25.000 Datensätze.
Wäre klasse, wenn da jemand eine gute Idee hat.
VG aus Bayern
Elmar
Sub Aufteilen()
Dim Zelle1 As Range, Zelle2 As Range
Dim wb As Workbook
Dim Pfad As String
Pfad = "C:\Daten\Virtueller Scan\Aufteilungen"
With ActiveSheet
'--- Quelltabelle sortieren
.UsedRange.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
'--- neue leere Datei anlegen, Überschriften und Spaltenbreiten übernehmen
Set wb = Workbooks.Add(xlWBATWorksheet)
.UsedRange.Copy
wb.Sheets(1).PasteSpecial xlPasteColumnWidths
.Rows(1).Copy Destination:=wb.Sheets(1).Cells(1, 1)
'--- Daten übernehmen
Set Zelle1 = .Cells(2, 1)
Do Until Zelle1.Value = ""
'--- Kriterium letzte Zeilen finden
Set Zelle2 = .Columns(1).Find(what:=Zelle1.Value, _
lookat:=xlWhole, LookIn:=xlValues, _
searchdirection:=xlPrevious)
'--- Zieltabelle leeren
wb.Sheets(1).UsedRange.Offset(1, 0).Clear
'--- Daten kopieren
Range(Zelle1, Zelle2).EntireRow.Copy Destination:=wb.Sheets(1).Cells(2, 1)
'--- Speichern
wb.SaveAs Pfad & "\" & Zelle1.Value, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'--- nächstes Kriterium erste Zeile finden
Set Zelle1 = Zelle2.Offset(1, 0)
Loop
wb.Close
End With
End Sub
Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datensätze auf mehrere Dateien aufteilen
06.02.2023 11:22:08
ChrisL
Hi
Ich habe mal ChatGPT (Link im Forumstitel) gefragt. Resultat sieht auf den ersten Blick OK aus.
VBA Excel teile eine Excel-Tabelle in Einzeldateien zu je 500 Zeilen auf
Hier ist ein VBA-Code-Snippet, das eine Excel-Tabelle in mehrere Einzeldateien mit jeweils 500 Zeilen aufteilt:
Sub SplitIntoMultipleFiles()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim lRow As Long
    Dim sFileName As String
    
    'Ändern Sie diesen Pfad, um den Ordner zu ändern, in dem die Dateien gespeichert werden sollen
    Const sPath As String = "C:\temp\"
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1") 'Ändern Sie "Sheet1" in den Namen der gewünschten Arbeitsblatt
    lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    k = 1
    For i = 1 To lRow Step 500
        Set rng = ws.Range("A" & i & ":A" & i + 499)
        sFileName = sPath & "File" & k & ".xlsx"
        k = k + 1
        
        'Erstelle ein neues Arbeitsbuch und kopiere die Zeilen
        Set wb = Workbooks.Add
        rng.Copy wb.Sheets(1).Range("A1")
        wb.SaveAs sFileName, xlOpenXMLWorkbook
        wb.Close
    Next i
End Sub
Führen Sie diesen Code aus, um die Tabelle in mehrere Einzeldateien aufzuteilen. Stellen Sie sicher, dass Sie den Pfad korrekt angeben, um den Ordner zu ändern, in dem die Dateien gespeichert werden sollen.
cu
Chris
Anzeige
AW: Datensätze auf mehrere Dateien aufteilen
06.02.2023 11:34:08
Elmar
Hallo Chris,
zunächst mal DANKE für deine Arbeit hierzu
Es läuft auch perfekt, allerdings möchte ich nicht nur die Daten aus Spalte A sondern alles aus Spalte A bis G kopiert haben.
Kannst du das noch erweitern?
Wäre klasse, danke schon mal
VG
Elmar
AW: Datensätze auf mehrere Dateien aufteilen
06.02.2023 11:51:06
Rudi
Hallo,
Set rng = ws.Range("A" & i & ":G" & i + 499)
Gruß
Rudi
Anzeige
AW: Datensätze auf mehrere Dateien aufteilen
06.02.2023 13:33:17
Elmar
Hallo zusammen,
hab alles angepasst, läuft super und nochmal DANKE
VG
Elmar
AW: Datensätze auf mehrere Dateien aufteilen
06.02.2023 11:25:38
Fennek
Hallo,
hier auf die alte Methode:
Sub Zeile_to_Sheet()
Dim WS As Worksheet, Sht As Worksheet
Set WS = ActiveSheet
For i = 2 To WS.Cells(Rows.Count, 1).End(xlUp).Row Step 50
    Set Sht = Sheets.Add(, Sheets(Sheets.Count))
    WS.Cells(i, 1).Resize(50).Copy Sht.Cells(2, 1)
    Sht.Cells(1, 1) = WS.Cells(1, 1)
Next i
End Sub
mfg
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige