Changing structure of data

This works for your example:

Sub x()

Dim r As Long

Application.ScreenUpdating = False

With Sheet1.Range("A1").CurrentRegion
    For r = 2 To .Rows.Count
        .Cells(r, 1).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2).Resize(.Columns.Count - 1)
        .Cells(1, 2).Resize(, .Columns.Count - 1).Copy
        Sheet2.Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial Transpose:=True
    Next r
    Sheet2.Rows(1).Delete shift:=xlUp
End With

Application.ScreenUpdating = True

End Sub