Zellen in untere Zeilen per VBA kopieren mit zusätzlicher Zeile nach jedem Schritt

[exblow375]

Hallo zusammen,

ich habe vor kurzer Zeit bei Excel VBA meinen Einstieg gefunden, bin aber noch sehr unsicher in allem.

Ich hänge an folgender Frage:
Wie kann ich „Zellen runterkopieren“ und dabei den Zielbereich mit jedem Schritt vergrößern?
So soll z.B. in Spalte A Zeile 10 der Inhalt in Zeile 11 kopiert werden und dies soll dann in jeder 15. Zeile dieser Spalte wiederholt werden, allerdings soll bei jedem Schritt die Anzahl der kopierten Zeilen erhöht werden. 
Im nächsten Schritt wäre dann der Inhalt also in Zeile 25. Dieser soll dann nicht nur in Zeile 26 sondern zusätzlich Zeile 27 kopiert werden; dann soll Zeile 40 in 41-43 kopiert werden usw. 

Ich habe mich schon an dem Code versucht allerdings scheitere ich an der Frage wie bei jedem Schritt die Anzahl der Zeilen im Zielbereich erhöhe. Ich vermute das ich eine zusätzliche Variable laufen lassen muss? Kann mir bitte jemand helfen?



Sub ZellenKopieren ()
Dim i As Integer 

For i = 10 To Cells(Rows.Count, 1).End(xlUp).Row Step 15
Cells(i, 1).Select
Selection.AutoFill Destination:=Cells(i+1,1) Type:=xlFillDefault
next i

End Sub

[Kuwer]

Hallo,

so vielleicht:

Sub ZellenKopieren()
  Dim i As Long, j As Long
  
  For i = 10 To Cells(Rows.Count, 1).End(xlUp).Row Step 15
    j = j + 1
    Cells(i, 1).Copy Cells(i + 1, 1).Resize(j)
  Next i
End Sub

Gruß Uwe

[exblow375]

Hallo,

so vielleicht:

Sub ZellenKopieren()
  Dim i As Long, j As Long
  
  For i = 10 To Cells(Rows.Count, 1).End(xlUp).Row Step 15
    j = j + 1
    Cells(i, 1).Copy Cells(i + 1, 1).Resize(j)
  Next i
End Sub

Gruß Uwe

Das sieht gut aus! Vielen Dank! Problem ist nur das ich ein entscheidendes Detail vergessen hatte. Die Erhöhung um eine Zeile soll nach jedem 9. Schritt durchgeführt werden. Also in den ersten 9 Runden soll nur eine Zelle jeweils kopiert werden, danach dann 2 usw..

[Kuwer]

Hallo,

Sub ZellenKopieren()
  Dim i As Long, j As Long
  j = 9
  For i = 10 To Cells(Rows.Count, 1).End(xlUp).Row Step 15
    Cells(i, 1).Copy Cells(i + 1, 1).Resize(Fix((j) / 9))
    j = j + 1
  Next i
End Sub

Gruß Uwe

[exblow375]

Hallo,

Sub ZellenKopieren()
  Dim i As Long, j As Long
  j = 9
  For i = 10 To Cells(Rows.Count, 1).End(xlUp).Row Step 15
    Cells(i, 1).Copy Cells(i + 1, 1).Resize(Fix((j) / 9))
    j = j + 1
  Next i
End Sub

Gruß Uwe

Genial! Das läuft genau wie ich es brauch, ganz lieben Dank!! Hätte ich mir wohl die Zähne dran ausgebissen..