HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Entdecke rund 2 Millionen Excel-Lösungen im
Forumsarchiv
Forumbeitrag
Excel-Version des Fragestellers:
365 privat
Erfahrungslevel des Fragestellers:
Excel gut - VBA nein
Alwin Weisangler
29.06.2026 13:57:04
AW: VBA: Konvertierung einer Tabelle in eine bestimmte Vorlage
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
Als Antwort auf diesen Beitrag
Alwin Weisangler
29.06.2026 13:51:29
AW: VBA: Konvertierung einer Tabelle in eine bestimmte Vorlage
Ich hoffe ich habe es richtig verstanden, dann wäre es 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" & StartQuelle & ":AU" & StartQuelle).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
Antwort auf Beitrag erstellen
Bitte einen Anwendernamen ohne @ eingeben.
Bitte das Passwort eingeben.
Bitte eine gültige E-Mail-Adresse eingeben.
Bitte einen Betreff eingeben.
Weitere Optionen
Aktivieren, wenn die Frage/der Beitrag noch nicht beantwortet wurde und unter Listen > Offene Threads erscheinen soll.
Beispieldatei hochladen

Bitte einen Nachrichtentext eingeben.