Die Aufgabe

Aus ein­er beste­hen­den Tabelle soll (beispiel­sweise) jede vierte Zeile in ein neues Tabel­len­blatt der gle­ichen Arbeitsmappe kopiert wer­den. Es gibt eine Über­schrift-Zeile in der Quell-Tabelle, welche getren­nt in die Ziel-Tabelle kopiert wer­den soll. Die Zäh­lung der Dat­en soll mit der Zeile unter­halb der Über­schrift, also (im Nor­mal­fall)  ab Zeile 2 begin­nen. Das bedeutet in diesem Beispiel, dass die Zeilen 5, 9, 13, … kopiert wer­den sollen

▲ nach oben …

Die Lösung

Zugegeben, mit ein­er Hil­f­ss­palte geht es auch ohne VBA. Lesen Sie hier mehr dazu. In der zum Down­load bere­it gestell­ten Arbeitsmappe sind es das dritte und vierte Reg­is­ter, wo kein VBA einge­set­zt wurde und über die Hil­f­ss­palte ein Fil­ter geset­zt wor­den ist. Die gefilterten Dat­en sind dann per C:P in die nach­fol­gende Tabelle einge­fügt wor­den.

Mit VBA, also ein­er Makro-Lösung ist das alles immer dann viel ein­fach­er, wenn solch eine Anforderung öfter ein­mal vorkommt und dann vielle­icht auch noch die Daten­bere­iche (Zeilen und Spal­ten) unter­schiedlich groß sind. Und wenn es mal jede zweite, fün­fte, zehnte, … Zeile ist, die kopiert wer­den soll, dann genügt eine einzige kleine Anpas­sung im Code, dass entwed­er bei jedem Aufruf in einem kleinen Fen­ster (ein­er Input­Box) die „Sprung­weite” abge­fragt wird oder Sie ändern im Code genau diesen Wert an 1 Stelle.

Die Datei mit dem Source­code und vier Tabel­len­blät­tern find­en Sie hier zum Down­load, den Code habe ich direkt hierunter noch ein­mal dargestellt; er liegt auch gepack­te Text­datei für Sie bere­it. Es ist ein aus mein­er Sicht „gesun­der” Mit­tel­weg zwis­chen Geschwindigkeit und Nachvol­lziehbarkeit des Codes. Im Anschluss fol­gen noch einige wenige Kom­mentare dazu, aber in erster Lin­ie ist diese Rou­tine für User gedacht, die erforder­lichen­falls Anpas­sun­gen vornehmen kön­nen und schon wis­sen, was sie da ger­ade 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

Hin­weis: Ich nehme hier Bezug auf die Zeilen­num­mern, wie sie sich in dieser *.zip-gepack­ten Text-Datei mit dem Code darstellen. Wenn Sie zum Betra­cht­en den sehr guten kosten­losen Edi­tor Notepad++ ein­set­zen, dann wer­den Ihnen auch die Zeilen­num­mern angezeigt (gilt aber auch für ver­schiedene andere Edi­toren). Falls Sie MS Word oder eine andere Textver­ar­beitung dazu ein­set­zen, bitte im Anschluss nicht spe­ich­ern, da diese Pro­gramme die Struk­tur ein­er Text-Datei zer­stören.

Hier nun die einzel­nen Hin­weis-Punk­te:

• Aus Grün­den der Geschwindigkeit wird ein Array ver­wen­det, welch­es vor dem Füllen mit den berech­neten Werten dimen­sion­iert wird.
• Zeilen 10–11: Hier müssen bei Bedarf die Namen der Tabellen angepasst wer­den.
• Zeile 12: Hier eingeben, in welchem Inter­vall die Zeilen kopiert wer­den sollen.
• Zeilen 21–23: Die Über­schriften in das Array schreiben.
• Zeilen 27–34: Jede 4. Zeile (oder entsprechend der Vari­ablen Sprung)
• Zeile 36: Das Array in die Ziel-Tabelle Zelle A1 schreiben

[NachOben­Let­zte Verweis=„ML: Jede n’te Zeile kopieren”]