Aus ver­schiede­nen Grün­den kann es sin­nvoll oder erforder­lich sein, eine umfan­gre­iche Tabelle  in mehrere kleinere Ein­heit­en aufzuteilen, zu split­ten. Wenn als Kri­teri­um „nur” eine definierte Zahl von Daten­sä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 wer­den für Ihre Bedürfnisse gewiss noch dieses oder jenes anpassen müssen. Ins­beson­dere sind dieses :

• Der Pfad, wo die Ergeb­nisse des Splits gespe­ichert wer­den sollen. Beacht­en Sie, dass der Pfad (der Ord­ner) existieren muss).
• Der grund­sät­zliche Name der Ziel-Dateien ohne Dateina­men-Erweiterung.
• Die Block-Größe, also die Anzahl der Daten­sätze je Ziel­d­atei.

Derzeit ist die Ein­stel­lung so, dass mit ein­er Dateina­men-Erweiterung *.xls gespe­ichert wird. Dafür gibt es einen mitunter wichti­gen Grund: Dieses For­mat ist auch für ältere Excel-Ver­sio­nen oder Fremd­pro­gramme prob­lem­los les­bar. Und bei der Gele­gen­heit: Eine Über­sicht der ver­schiede­nen Möglichkeit­en des For­mats find­en Sie hier auf der Seite von Microsoft. Möcht­en Sie bei dem eigentlichen For­mat bleiben und nur die Endung auf *.xlsx anpassen, dann ändern sie bitte die entsprechende Zeile so:

DateiFormat = xlWorkbookDefault

Hin­weis: Unter Win­dows 10 mit Excel 2013 scheint es ein Prob­lem zu geben, wenn die Datei als *.csv gespe­ichert wer­den soll. Trotz des Argu­ments Local:=True und kor­rek­ter Lan­de­se­in­stel­lun­gen in Win­dows wird die US-Norm ver­wen­det: Kom­mas als Spal­tentren­ner, Punkt als Dez­i­mal­tren­ner, etc. Stand: Ende 2015.

Was zu bedenken ist: Der Pro­gram­ma­blauf kann lange dauern; sehr lange; extrem lange, wenn sehr viele Dateien erstellt wer­den. Denken Sie also nicht, dass ein Fehler zu den eventuell lan­gen Laufzeit­en führt oder der Rech­n­er abgestürzt ist. 💡 

▲ nach oben …

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

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