Sub t()
Dim lr As Long, lc As Long, c As Range
With ActiveSheet
Columns(1).Insert
lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
For Each c In .Range("B1:B" & lr)
Range(c, .Cells(c.Row, Columns.Count).End(xlToLeft)).Copy
.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial Transpose:=True
Next
.Range("B1", .Cells(lr, lc)).ClearContents
End With
Application.CutCopyMode = False
End Sub