Sub TranposeData()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim lColumn As Long
lColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Dim x As Long
For x = 1 To LastRow
lColumn = ActiveSheet.Cells(x, Columns.Count).End(xlToLeft).Column
Range(Cells(x, 1), Cells(x, lColumn)).Copy
Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next x
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub