Schleifen Problem

[xChristianx]

Sehr geehrte Community,

ich habe erneut ein Problem mit einer Schleife.
Und zwar möchte ich nun Nummern in verschieden Tabellenblätter kopieren.
Ich habe mich wieder beim Makrorekorder bedient.
Die Aktion die ich durchführen möchte sieht so aus:
   
    Range("A3").Select
    Selection.Copy

    Sheets("Tabelle1").Select
    Range("A2").Select
    ActiveSheet.Paste

    Sheets("Tabelle2").Select
    Range("A2").Select
    ActiveSheet.Paste

    Sheets("Tabelle3").Select
    Range("A2").Select
    ActiveSheet.Paste

    Sheets("Tabelle4").Select
    Range("A2").Select
    ActiveSheet.Paste

    Sheets("Tabelle5").Select
    Range("A2").Select
    ActiveSheet.Paste

Die Seriennummern die aus der Ausgangstabelle (Tabelle6) kopiert werden wandern jeweils pro schleife um 5 nach rechts.
Daher habe ich schon einmal den Anfang der for-Schleife:

Dim h as Long

For h = 1 To Columns.Count Step 5
   If Not IsEmpty(Cells(3, h)) Then
   Cells(3, h).Select
   Selection.Copy
   Sheets("Tabelle1").Select
...

Dann sollen die Nummern auf die Tabellen aufgeteilt werden, sodass der 2.Durchlauf in etwa so aussieht (Makrorekorder)

    Range("F3").Select
    Selection.Copy

    Sheets("Tabelle1").Select
    Range("A17").Select
    ActiveSheet.Paste

    Sheets("Tabelle2").Select
    Range("A18").Select
    ActiveSheet.Paste

    Sheets("Tabelle3").Select
    Range("A13").Select
    ActiveSheet.Paste

    Sheets("Tabelle4").Select
    Range("A11").Select
    ActiveSheet.Paste

    Sheets("Tabelle5").Select
    Range("A8").Select
    ActiveSheet.Paste

Das Problem was ich jetzt habe ist, dass ich nicht weiß wie ich 5 Laufvariablen, die jeweils unterschiedlich ansteigen in eine Schleife packen soll.
Bei h ist es klar, da nehm ich "Step 5" und die Spalten wandern pro Durchlauf um 5 nach rechts.
Ich habe mir erst überlegt 5 Schleifen hintereinander zu machen aber das hat nicht funktioniert dann habe ich einfach das versucht:

Sub SerienNummernÜbertragenSchleife()

Dim h As Long, i As Long, j As Long, k As Long, l As Long, m As Long

    For h = 1 To Columns.Count Step 5
    If Not IsEmpty(Cells(3, h)) Then
    Cells(3, h).Select
    Selection.Copy
    Sheets("Tabelle1").Select
    i = 2
        Cells(i, 1).Select
        ActiveSheet.Paste
      Sheets("Tabelle2").Select
        i = i + 15
      j = 2
            Cells(j, 1).Select
            ActiveSheet.Paste
            Sheets("Tabelle3").Select
            j = j + 16
          k = 2
                Cells(k, 1).Select
                ActiveSheet.Paste
                Sheets("Tabelle4").Select
                k = k + 11
              l = 2
                    Cells(l, 1).Select
                    ActiveSheet.Paste
                   Sheets("Tabelle5").Select
                    l = l + 9
                  m = 2
                        Cells(m, 1).Select
                       ActiveSheet.Paste
                        m = m + 6
                     
        Else
        Exit For
    End If
    Next h
End Sub



Das Makro läuft, jedoch spricht es nur die Zellen A2 jedes Tabellenblatts an und trägt überall die Zahl 84 ein statt die gewünschten Nummern.
Hat jemand einen Tipp? Ich habe noch nicht so viel mit Excel VBA gearbeitet.

Ich bin für jeden Ratschlag dankbar.


Mit freundliche Grüßen

Christian

[xChristianx]

Habe das Makro etwas angepasst und erst einmal nur für ein Tabellenblatt gekürzt.
Sub LedStatusNummern()
Dim i As Long
Dim j As Long
For i = 1 To Columns.Count Step 5
    If Not IsEmpty(Cells(3, i)) Then
    Cells(3, i).Select
    Selection.Copy
    Sheets("Tabelle2").Select
    j = 2
        Cells(j, 1).Select
        ActiveSheet.Paste
        j = j + 16
        Sheets("Tabelle1").Select
        Else
        Exit For
    End If
    Next i
End Sub

Jetzt werden jedoch die Nummern immer wieder in die gleiche Zelle kopiert, d.h. das Makro wandert nicht die Zeilen ab sondern bleibt bei j=2

Wie schaffe ich es, dass pro Durchlauf die Zeile um die gewünschte Zahl 16 erhöht wird?

[IchBinIch]

Hallo Christian,

j = 2 gehört vor die Schleife sonst setzt er bei jedem Durchlauf j wieder auf 2 :32:

Code:

Sub LedStatusNummern()
Dim i As Long
Dim j As Long

j = 2

For i = 1 To Columns.Count Step 5
   If Not IsEmpty(Cells(3, i)) Then
   Cells(3, i).Select
   Selection.Copy
   Sheets("Tabelle2").Select

       Cells(j, 1).Select
       ActiveSheet.Paste
       j = j + 16
       Sheets("Tabelle1").Select
       Else
       Exit For
   End If
   Next i
End Sub

[xChristianx]

Danke für die antwort, bin grad selber ebenfalls drauf gekommen und jetzt läuft alles soweit.
Habe das ganze auch mit einer do until schleife gelöst.

Vielen Dank!

Mfg

Christian