Aus ver­schiede­nen Grün­den kann es sin­nvoll oder erforder­lich sein, eine umfan­gre­iche Ta­bel­le  in meh­re­re klei­ne­re Ein­heit­en auf­zu­tei­len, zu split­ten. Wenn als Kri­teri­um „nur” eine de­fi­nier­te Zahl von Daten­sätzen ist, dann bie­tet sich solch ein Ma­kro 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 Be­dürf­nis­se ge­wiss noch die­ses oder je­nes an­pas­sen müs­sen. Ins­beson­dere sind die­ses :

• Der Pfad, wo die Ergeb­nisse des Splits gespe­ichert wer­den sol­len. Beacht­en Sie, dass der Pfad (der Ord­ner) exis­tie­ren muss).
• Der grund­sät­zliche Name der Ziel-Da­tei­en ohne Dateina­men-Erweiterung.
• Die Block-Grö­ße, also die An­zahl der Daten­sätze je Ziel­d­atei.

Der­zeit ist die Ein­stel­lung so, dass mit ein­er Dateina­men-Erweiterung *.xls gespe­ichert wird. Da­für gibt es ei­nen mit­un­ter wichti­gen Grund: Die­ses For­mat ist auch für äl­te­re 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 Sei­te von Mi­cro­soft. Möcht­en Sie bei dem ei­gent­li­chen For­mat blei­ben und nur die En­dung auf *.xlsx an­pas­sen, dann än­dern sie bit­te die ent­spre­chen­de Zei­le so:

DateiFormat = xlWorkbookDefault

Hin­weis: Un­ter Win­dows 10 mit Ex­cel 2013 scheint es ein Prob­lem zu ge­ben, wenn die Da­tei 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 be­den­ken ist: Der Pro­gram­ma­blauf kann lan­ge dau­ern; sehr lan­ge; ex­trem lan­ge, wenn sehr vie­le Da­tei­en er­stellt wer­den. Den­ken Sie also nicht, dass ein Feh­ler zu den even­tu­ell lan­gen Laufzeit­en führt oder der Rech­n­er ab­ge­stürzt ist. 💡 

▲ nach oben …

Hat Ih­nen der Bei­trag ge­fal­len?
Er­leich­tert die­ser Bei­trag Ihre Ar­beit?

Dann wür­de ich mich über ei­nen Bei­trag Ihrer­seits z.B. 1,00 € freu­en … (← Klick mich!)