Hücre içinde değer ayıklama

Hücre içerisinde ayraç arasında ki değeri başka kolona aktaran Visual Basic kodu

Sub Parcala()
    Dim kelime, ayrac As String
    Dim satir, sutun, Yapistir As Variant
'*******************
'ayrac = "."
'sutun = "2"
'satir = "1"
'Yapistir = "3"
'*******************

    ayrac = InputBox("Ayririci Ne Olacak", "Ayrac Girin")
    sutun = InputBox("Hangi Sutundan Baslasin", "Hangi Sutundan Baslasin")
    satir = InputBox("Satir Baslangic Sayisi", "Satir Baslangic Sayisi")
    Yapistir = InputBox("Bulunan deger nereye yapistirilsin", "Bulunan deger nereye yapistirilsin")

'       For i = CInt(satir) To Columns(CInt(sutun)).End(xlDown).Row
        For i = CInt(satir) To Cells(Rows.Count, CInt(sutun)).End(xlUp).Row
        kelime = Cells(i, CInt(sutun)).Value
        If kelime = "" Then GoTo atla:
        kelime = Mid(kelime, (InStr(1, kelime, ayrac, 0) + 1), Len(kelime))
        Cells(i, CInt(Yapistir)).Value = Mid(kelime, 1, (InStr(1, kelime, ayrac, 0) - 1))

        If (Cells(i + 1, CInt(sutun)).Value = "") And (Cells(i + 2, CInt(sutun)).Value = "") And (Cells(i + 3, CInt(sutun)).Value = "") And (Cells(i + 4, CInt(sutun)).Value = "") Then Exit For
atla:
         Next

End Sub