Als Antwort auf diesen Beitrag
Hallo,
hier mal für beide Wege:
Option Explicit
Const StartQuelle As Long = 2
Const iZeilen As Long = 35
Sub UebertragenAlleSpalten()
Dim i&, j&, k&, lz&, arrZ(), arrQ: arrQ = Tabelle1.Cells(1, 1).CurrentRegion.Offset(1)
ReDim arrZ(1 To 35, 1 To Tabelle1.Cells(StartQuelle - 1, Columns.Count).End(xlToLeft).Column)
For i = LBound(arrQ) To UBound(arrQ) - 1
For j = 1 To Tabelle1.Cells(StartQuelle - 1, Columns.Count).End(xlToLeft).Column
For k = 1 To iZeilen
arrZ(k, j) = arrQ(i, j)
Next k
Next j
With Tabelle2
lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lz, 1).Resize(iZeilen, UBound(arrZ, 2)) = arrZ
End With
Next i
End Sub
Sub UebertragenNurA()
Dim i&, j&, lz&, arrZ(), arrQ: arrQ = Tabelle1.Range("A" & StartQuelle & ":A" & Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row).Value
ReDim arrZ(1 To 35, 1 To 1)
For i = LBound(arrQ) To UBound(arrQ)
For j = 1 To iZeilen
arrZ(j, 1) = arrQ(i, 1)
Next j
With Tabelle2
lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lz, 1).Resize(iZeilen, 1) = arrZ
End With
Next i
End Sub
Gruß Uwe