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