Excelde bir sütünda yazan değerleri birer atlamalı şekilde ayrı sütünlara ayırma soru

[darkvenue]

Merhabalar,
Excelde bir listem var bir sütünda yazan isim ve numaralar var her ismin altındaki sayıyı ismin karşısına yazmak için nasıl bir formül yada makro yazmak gerekir.
Örnek ektedir.

 

[askm]

Sub askm()
a = 1
Application.ScreenUpdating = False
For i = 1 To Range("A" & Rows.Count).End(3).Row
    If IsNumeric(Cells(i, 1)) = True Then
        Cells(a, 6) = Cells(i, 1)
        a = a + 1
    Else
        Cells(a, 5) = Cells(i, 1)
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub