Die Aufgabe

Aus einer bestehenden Tabelle soll (beispielsweise) jede vierte Zeile in ein neues Tabellenblatt der gleichen Arbeitsmappe kopiert werden. Es gibt eine Überschrift-Zeile in der Quell-Tabelle, welche getrennt in die Ziel-Tabelle kopiert werden soll. Die Zählung der Daten soll mit der Zeile unterhalb der Überschrift, also (im Normalfall)  ab Zeile 2 beginnen. Das bedeutet in diesem Beispiel, dass die Zeilen 5, 9, 13, … kopiert werden sollen

▲ nach oben …

Die Lösung

Zugegeben, mit einer Hilfsspalte geht es auch ohne VBA. Lesen Sie hier mehr dazu. In der zum Download bereit gestellten Arbeitsmappe sind es das dritte und vierte Register, wo kein VBA eingesetzt wurde und über die Hilfsspalte ein Filter gesetzt worden ist. Die gefilterten Daten sind dann per C:P in die nachfolgende Tabelle eingefügt worden.

Mit VBA, also einer Makro-Lösung ist das alles immer dann viel einfacher, wenn solch eine Anforderung öfter einmal vorkommt und dann vielleicht auch noch die Datenbereiche (Zeilen und Spalten) unterschiedlich groß sind. Und wenn es mal jede zweite, fünfte, zehnte, … Zeile ist, die kopiert werden soll, dann genügt eine einzige kleine Anpassung im Code, dass entweder bei jedem Aufruf in einem kleinen Fenster (einer InputBox) die “Sprungweite” abgefragt wird oder Sie ändern im Code genau diesen Wert an 1 Stelle.

Die Datei mit dem Sourcecode und vier Tabellenblättern finden Sie hier zum Download, den Code habe ich direkt hierunter noch einmal dargestellt; er liegt auch gepackte Textdatei für Sie bereit. Es ist ein aus meiner Sicht “gesunder” Mittelweg zwischen Geschwindigkeit und Nachvollziehbarkeit des Codes. Im Anschluss folgen noch einige wenige Kommentare dazu, aber in erster Linie ist diese Routine für User gedacht, die erforderlichenfalls Anpassungen vornehmen können und schon wissen, was sie da gerade tun. 😉

▲ nach oben …

Der Code

Option Explicit

Sub JedeXteZeile()
   Dim wksSrc As WorkSheet, wksDst As WorkSheet
   Dim rngSrcData As Range, c As Range
   Dim lRow As Long, Anz As Long, lCol As Integer
   Dim aDaten()
   Dim Sprung As Integer, i As Long, ArrZe As Long

   Set wksSrc = Sheets("Tabelle1")
   Set wksDst = Sheets("Tabelle2")
   Sprung = 4 ‚jede 4. Zeile
   With wksSrc
      lRow = .Cells(Rows.Count, 1).End(xlUp).Row ‚Spalte_A
      lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
      Set rngSrcData = .Range(.Cells(2, 1), .Cells(lRow, 1))
      Anz = Int((rngSrcData.Rows.Count) / 4)
      ReDim aDaten(Anz, lCol)

      For i = 1 To lCol ‚Überschrift
         aDaten(0, i – 1) = .Cells(1, i)
      Next i
      
      i = 1
      ArrZe = 1
      For Each c In rngSrcData
         If (c.Row – 1) Mod 4 = 0 Then
            For i = 1 To lCol
               aDaten(ArrZe, i – 1) = .Cells(c.Row, i)
            Next i
            ArrZe = ArrZe + 1
         End If
      Next c
   End With

   wksDst.Range("A1").Resize(Anz + 1, lCol) = aDaten()
   Set wksSrc = Nothing
   Set wksDst = Nothing
   Set rngSrcData = Nothing
End Sub

▲ nach oben …

Einige wenige Anmerkungen zum Code

Hinweis: Ich nehme hier Bezug auf die Zeilennummern, wie sie sich in dieser *.zip-gepackten Text-Datei mit dem Code darstellen. Wenn Sie zum Betrachten den sehr guten kostenlosen Editor Notepad++++ einsetzen, dann werden Ihnen auch die Zeilennummern angezeigt (gilt aber auch für verschiedene andere Editoren). Falls Sie MS Word oder eine andere Textverarbeitung dazu einsetzen, bitte im Anschluss nicht speichern, da diese Programme die Struktur einer Text-Datei zerstören.

Hier nun die einzelnen Hinweis-Punkte:

• Aus Gründen der Geschwindigkeit wird ein Array verwendet, welches vor dem Füllen mit den berechneten Werten dimensioniert wird.
• Zeilen 10-11: Hier müssen bei Bedarf die Namen der Tabellen angepasst werden.
• Zeile 12: Hier eingeben, in welchem Intervall die Zeilen kopiert werden sollen.
• Zeilen 21-23: Die Überschriften in das Array schreiben.
• Zeilen 27-34: Jede 4. Zeile (oder entsprechend der Variablen Sprung)
• Zeile 36: Das Array in die Ziel-Tabelle Zelle A1 schreiben

[NachObenLetzte Verweis=”ML: Jede n’te Zeile kopieren”]