Aus verschiedenen Gründen kann es sinnvoll oder erforderlich sein, eine umfangreiche Tabelle  in mehrere kleinere Einheiten aufzuteilen, zu splitten. Wenn als Kriterium „nur“ eine definierte Zahl von Datensätzen ist, dann bietet sich solch ein Makro an:

Option Explicit

Sub SplitDataSheet()
   Dim lRow As Long, lCol As Integer, BlockGroesse As Integer
   Dim AnzNullen As Byte, Nullen As String
   Dim rngZeile1 As Range, rngBlock As Range, Block As Integer
   Dim ZeBlockS As Long, ZeBlockE As Long, AnzBlocks As Integer
   Dim DstPath As String, DstName As String, DstFileName As String
   Dim wksSrc As Worksheet, rng2Copy As Range, DateiFormat As Variant
   
   Set wksSrc = ActiveSheet
   lRow = Cells(Rows.Count, 1).End(xlUp).Row
   lCol = Cells(1, Columns.Count).End(xlToLeft).Column
   BlockGroesse = 1000   'Je 1000 Zeilen in neue Datei
   DateiFormat = xlWorkbookNormal  'Alternativ:  xlCSV,  xlTextWindows,  xlWorkbookDefault, ...
   If lRow < 2 Then Exit Sub  'Nur überschrift macht keinen Sinn ...
   On Error GoTo ErrorHandler

   With Application
      .DisplayAlerts = False
      .ScreenUpdating = False
   End With
   AnzBlocks = WorksheetFunction.RoundUp((lRow - 1) / BlockGroesse, 0)
   AnzNullen = Len(CStr(AnzBlocks))
   Nullen = WorksheetFunction.Rept(0, AnzNullen)
   DstPath = "C:\Test\"
   DstName = "Splitted_"
   
   With wksSrc
      Set rngZeile1 = .Range(.Cells(1, 1), .Cells(1, lCol))
      For Block = 1 To AnzBlocks
         DstFileName = DstPath & DstName & Format(Block, Nullen)
         ZeBlockS = (Block - 1) * BlockGroesse + 2
         ZeBlockE = WorksheetFunction.Min(ZeBlockS + BlockGroesse - 1, lRow)
         Set rng2Copy = Union(rngZeile1, .Range(.Cells(ZeBlockS, 1), .Cells(ZeBlockE, lCol)))
         rng2Copy.Copy
         Workbooks.Add
         With ActiveSheet
            .Paste
            .Cells(1, 1).Select
         End With
         With ActiveWorkbook
            .SaveAs Filename:=DstFileName, FileFormat:=DateiFormat
            .Close SaveChanges:=True
         End With
      Next Block
   End With

ErrorHandler:
   With Application
      .DisplayAlerts = True
      .ScreenUpdating = True
   End With
   If Err.Number = 0 Then
      MsgBox "Aufgabe erledigt!", vbInformation, "Ohne Fehler"
   Else
      MsgBox "Beendet mit Fehler Nr.: " & Err.Number & vbCrLf _
       & Err.Description & vbCrLf _
       & "Bitte prüfen Sie das Ergebnis!", vbCritical, "Fehler"
   End If
End Sub

Sie werden für Ihre Bedürfnisse gewiss noch dieses oder jenes anpassen müssen. Insbesondere sind dieses :

• Der Pfad, wo die Ergebnisse des Splits gespeichert werden sollen. Beachten Sie, dass der Pfad (der Ordner) existieren muss).
• Der grundsätzliche Name der Ziel-Dateien ohne Dateinamen-Erweiterung.
• Die Block-Größe, also die Anzahl der Datensätze je Zieldatei.

Derzeit ist die Einstellung so, dass mit einer Dateinamen-Erweiterung *.xls gespeichert wird. Dafür gibt es einen mitunter wichtigen Grund: Dieses Format ist auch für ältere Excel-Versionen oder Fremdprogramme problemlos lesbar. Und bei der Gelegenheit: Eine Übersicht der verschiedenen Möglichkeiten des Formats finden Sie hier auf der Seite von Microsoft. Möchten Sie bei dem eigentlichen Format bleiben und nur die Endung auf *.xlsx anpassen, dann ändern sie bitte die entsprechende Zeile so:

DateiFormat = xlWorkbookDefault

Hinweis: Unter Windows 10 mit Excel 2013 scheint es ein Problem zu geben, wenn die Datei als *.CSV gespeichert werden soll. Trotz des Arguments Local:=True und korrekter Landeseinstellungen in Windows wird die US-Norm verwendet: Kommas als Spaltentrenner, Punkt als Dezimaltrenner, etc. Stand: Ende 2015.

Was zu bedenken ist: Der Programmablauf kann lange dauern; sehr lange; extrem lange, wenn sehr viele Dateien erstellt werden. Denken Sie also nicht, dass ein Fehler zu den eventuell langen Laufzeiten führt oder der Rechner abgestürzt ist. 💡 

▲ nach oben …

Hat Ihnen der Beitrag gefallen?
Erleichtert dieser Beitrag Ihre Arbeit?

Dann würde ich mich über einen Beitrag Ihrerseits z.B. 1,00 € freuen … (← Klick mich!)