An alternative
Code:
Sub TransformData()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Dim lastcol As Long
Dim nextrow As Long
Dim i As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
ws2.UsedRange.ClearContents
With ws1
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
nextrow = 1
For i = 1 To lastrow
lastcol = .Cells(i, .Columns.Count).End(xlToLeft).Column
.Cells(i, "A").Resize(, lastcol).Copy
ws2.Cells(nextrow, "A").PasteSpecial Paste:=xlPasteAll, Transpose:=True
nextrow = nextrow + lastcol
Next i
End With
End Sub
Bookmarks