Verileri diğer sayfalara aktarılması

[1903emre34@gmail.com]

Merhaba,

Ekteki dosyada, "A" sütünda yer alan en sağdaki kalın boyanmış tutarlarından öncekileri diğer sütüna aktarılması için kodl oluşturabilir miyiz

 

[veyselemre]

Sub test()
    Dim i
    Range("B5:B" & Rows.Count).ClearContents
    For i = 5 To Cells(Rows.Count, 1).End(3).Row
        Cells(i, 2).Value = Trim(StrReverse(Split(StrReverse(Trim(Cells(i, 1).Value)), " ", 2)(1)))
    Next i
End Sub

Sub test2()
    Dim i, al, m
    Range("B5:E" & Rows.Count).ClearContents
    With CreateObject("VBScript.Regexp")
        .Pattern = "^(.+)\s([\d\.\,\-]+)\s([\d\.\,]+)\s([\d\.\,]+)(\s$)"
        For i = 5 To Cells(Rows.Count, 1).End(3).Row
            al = Cells(i, 1).Value
            Set m = .Execute(al)
            Cells(i, 2).Value = m(0).submatches(0)
            Cells(i, 3).Value = CDbl(m(0).submatches(1))
            Cells(i, 4).Value = CDbl(m(0).submatches(2))
            Cells(i, 5).Value = CDbl(m(0).submatches(3))
        Next i
    End With
End Sub

 

[1903emre34@gmail.com]

İlginiz için teşekkürler, ilk kod işe yaradı.