Transponer en excel números a filas

[Hola 

Te paso la macro 

Sub separa()
'
'[Por Adriel Ortiz
'
uc = 21
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    For k = 1 To 6
        Cells(1, uc) = Mid(Cells(i, "A"), k, 1)
        uc = uc + 1
    Next k
Next i
MsgBox "finalizado"
End Sub

Valora la respuesta para finalizar saludos!

Este código te valdrá:

Sub numeros()
Range("a2").Select
j = 0
i = 2
Do
ac = ActiveCell.Value
uno = Left(ac, 1)
dos = Right(Left(ac, 2), 1)
tres = Left(Right(ac, 2), 1)
cuatro = Right(ac, 1)
Cells(i, 21 + j) = uno
Cells(i, 22 + j) = dos
Cells(i, 23 + j) = tres
Cells(i, 24 + j) = cuatro
j = j + 7
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""
End Sub

Hay un error:

j = j + 7

debe ser

j = j + 6

Si tienes muchos registros, añade

Application.ScreenUpdating = False

al inicio y:

Application.ScreenUpdating = True

al final de la macro

La macro coloca información en u2 en adelante