Sub Transposer()
    Dim col As Long
    
    With Range("A1").CurrentRegion
        For col = 2 To .Columns.Count
            .Columns(col).Cut Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
        Next
    End With
End Sub