Falls du meinen im Beitrag gelisteten Code meinst, hier eine ungeprüfte Version (aber nur 1-fach) ;-)
Option Explicit
Sub TransformSpecial()
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim lRowSrc As Integer, lCol As Integer, lRowDst As Long
Dim Ze As Integer, Sp As Integer, i As Integer
Set wksDst = Sheets("Tabelle5")
For i = 1 To 4
Set wksSrc = Sheets("Tabelle" & i)
With wksSrc
lRowSrc = .Cells(Rows.Count, 1).End(xlUp).Row
lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With
For Ze = 1 To lRowSrc
lRowDst = wksDst.Cells(Rows.Count, 1).End(xlUp).Row
wksSrc.Range(Cells(Ze, 1), Cells(Ze, lCol)).Copy
wksDst.Cells(lRowDst + 1, 1).PasteSpecial Transpose:=True
Next Ze
Next i
wksDst.Rows(1).EntireRow.Delete
End Sub
|