Als Antwort auf diesen Beitrag
Sorry, da war noch ein Fehler drin.
so:
Option Explicit
Const StartQuelle As Long = 2
Const iZeilen As Long = 35
Sub UebertragenAlleSpalten()
Dim i&, j&, k&, lz&, arrZ(), arrSP(), arrTmp(), 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
arrTmp = Tabelle1.Range("M" & i + StartQuelle - 1 & ":AU" & i + StartQuelle - 1).Value
For j = 1 To Tabelle1.Cells(StartQuelle - 1, Columns.Count).End(xlToLeft).Column
For k = 1 To iZeilen
If j < 5 Then
arrZ(k, j) = arrQ(i, j)
ElseIf j = 5 Then
arrZ(k, j) = Tabelle3.Cells(k, 1)
Else
If j < 41 Then arrZ(k, j) = arrTmp(1, j - 5) 'Abfrage da Spalten aus Quelle übersprungen werden.
End If
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
Gruß Uwe