Schleife funktioniert fast :D

Private Sub CommandButton3_Click()
Anz = Tabelle3.Range("H3")
Cells(Start, 2).Resize(Anz, 1) = Tabelle3.Range("B3")
Cells(Start, 3).Resize(Anz, 1) = Tabelle3.Range("D3")
Cells(Start, 9).Resize(Anz, 1) = Tabelle3.Range("G3")
Cells(Start, 11).Resize(Anz, 1) = Tabelle3.Range("C3")
Cells(Start, 10).Resize(Anz, 1) = Tabelle3.Range("P3")
Start = Start + Anz
ReDim vArr(1 To Tabelle3.Range("H3"), 1 To 1)
For i = 1 To UBound(vArr())
vArr(i, 1) = Tabelle3.Range("E3") + (i - 1) * DauerF
Next
Cells(24, 4).Resize(UBound(vArr)) = vArr
ReDim vArr(1 To Tabelle3.Range("H3"), 1 To 1)
For i = 1 To UBound(vArr())
vArr(i, 1) = Tabelle3.Range("F3") + (i - 1) * DauerT
Next
Cells(24, 8).Resize(UBound(vArr)) = vArr
Anz = Tabelle3.Range("H4")
Cells(Start, 2).Resize(Anz, 1) = Tabelle3.Range("B4")
Cells(Start, 3).Resize(Anz, 1) = Tabelle3.Range("D4")
Cells(Start, 9).Resize(Anz, 1) = Tabelle3.Range("G4")
Cells(Start, 11).Resize(Anz, 1) = Tabelle3.Range("C4")
Cells(Start, 10).Resize(Anz, 1) = Tabelle3.Range("P4")
Start = Start + Anz
ReDim vArr(1 To Tabelle3.Range("H4"), 1 To 1)
For i = 1 To UBound(vArr())
vArr(i, 1) = Tabelle3.Range("E4") + (i - 1) * DauerF
Next
With Tabelle3
Cells(24 + .Range("H3"), 4).Resize(UBound(vArr)) = vArr
End With
ReDim vArr(1 To Tabelle3.Range("H4"), 1 To 1)
For i = 1 To UBound(vArr())
vArr(i, 1) = Tabelle3.Range("F4") + (i - 1) * DauerT
Next
With Tabelle3
Cells(24 + .Range("H3"), 8).Resize(UBound(vArr)) = vArr
End With
Anz = Tabelle3.Range("H5")
Cells(Start, 2).Resize(Anz, 1) = Tabelle3.Range("B5")
Cells(Start, 3).Resize(Anz, 1) = Tabelle3.Range("D5")
Cells(Start, 9).Resize(Anz, 1) = Tabelle3.Range("G5")
Cells(Start, 11).Resize(Anz, 1) = Tabelle3.Range("C5")
Cells(Start, 10).Resize(Anz, 1) = Tabelle3.Range("P5")
Start = Start + Anz
ReDim vArr(1 To Tabelle3.Range("H5"), 1 To 1)
For i = 1 To UBound(vArr())
vArr(i, 1) = Tabelle3.Range("E5") + (i - 1) * DauerF
Next
With Tabelle3
Cells(24 + .Range("H3") + .Range("H4"), 4).Resize(UBound(vArr)) = vArr
End With
ReDim vArr(1 To Tabelle3.Range("H5"), 1 To 1)
For i = 1 To UBound(vArr())
vArr(i, 1) = Tabelle3.Range("F5") + (i - 1) * DauerT
Next
With Tabelle3
Cells(24 + .Range("H4") + .Range("H3"), 8).Resize(UBound(vArr)) = vArr
End With
End Sub

Anz = Tabelle3.Range("H3")
Cells(Start, 2).Resize(Anz, 1) = Tabelle3.Range("B3")
Cells(Start, 3).Resize(Anz, 1) = Tabelle3.Range("D3")
Cells(Start, 9).Resize(Anz, 1) = Tabelle3.Range("G3")
Cells(Start, 11).Resize(Anz, 1) = Tabelle3.Range("C3")
Cells(Start, 10).Resize(Anz, 1) = Tabelle3.Range("P3")
Start = Start + Anz

Private Sub CommandButton1_Click()
Dim z As Long
Dim i As Long
Dim j As Long
With Tabelle3
i = 24
For z = 3 To 6
j = .Cells(z, 8)
Cells(i, 2).Resize(j, 1) = .Cells(z, 2)
Cells(i, 3).Resize(j, 1) = .Cells(z, 4)
Cells(i, 11).Resize(j, 1) = .Cells(z, 3)
Cells(i, 9).Resize(j, 1) = .Cells(z, 7)
Cells(i, 10).Resize(j, 1) = .Cells(z, 16)
i = i + j
Next
End With
End Sub
Dieser Teil leider nicht:
ReDim vArr(1 To Tabelle3.Range("H5"), 1 To 1)
For i = 1 To UBound(vArr())
vArr(i, 1) = Tabelle3.Range("F5") + (i - 1) * DauerT
Next
With Tabelle3
Cells(24 + .Range("H4") + .Range("H3"), 8).Resize(UBound(vArr)) = vArr
End With
Ansatz:
Private Sub CommandButton2_Click()
Dim z As Integer
Dim i As Long
Dim j As Long
Dim vArr()
i = 3
For q = 3 To 6
ReDim vArr(1 To Tabelle3.Cells(i, 8), 1 To 1)
For z = 1 To UBound(vArr())
vArr(z, 1) = Tabelle3.Cells(i, 5) + (z - 1) * 14
Next
Cells(24 + i, 4).Resize(UBound(vArr)) = vArr
i = i + z
Next
Diese Schleife soll folgendes erreichen:
In "E3" steht ein Datum in "H3" in Zahl z.B. 1
-> Datum soll 1 zu 1 in Tab1. aus Tab3. übertragen werden
In "E4" steht ein Datum in "H4" in Zahl z.B. 1
-> Datum soll 1 zu 1 Tab1. aus Tab3.übertragen werden
In "E5" steht ein Datum in "H5" in Zahl z.B. 3
-> Datum soll 1 zu 1 Tab1. aus Tab3. übertragen werden zusätzlich soll das Datum 2 mal jeweiles  _
um DauerF erhöht werden
usw. ...