Quick Transposer

A post from a Pistonhead member in need :

Sub QuickTranspose()

    Dim rng As Range
    Dim StartRowNum As Long
    Dim EndRowNum As Long
    Dim ColumnOffsetCounter As Long
    Dim GroupSize As Long
    Dim v
    Dim i As Long
    Dim TotalRows As Long
    GroupSize = 1000
    TotalRows = 50000
    
    'Dirty but without range names etc you just need to get the
    'selected cell to be the first one in the list
    Set rng = Application.Selection
    StartRowNum = rng.Rows.Row
    For i = 0 To TotalRows / GroupSize
        EndRowNum = StartRowNum + GroupSize - 1
        v = Range("A" & StartRowNum & ":A" & EndRowNum).Value
        Range(rng.Offset(0, i + 1), rng.Offset(GroupSize - 1, i + 1)).Value = v
        StartRowNum = EndRowNum + 1
    
    Next i
End Sub