Tek hücredeki rakamları ayrı hücrelere dağıtma

[gezgin-49]

arkadaşlar 11 haneli T.C.Kimlik numarasını sayfa1 de L13 hücresine bitişik yazıyorum, ama bu T.C.kimlik numarasının sayfa2' de 11 ayrı hücreye (A9,B9,C9,D9,E9,F9,G9,H9,I9,J9,K9) hücrelerine her bir hücreye bir rakam gelecek şekilde aktarılmasını istiyorum, yardımlarınız için şimdiden teşekkür eder, saygılar sunarım.

 

[Korhan Ayhan]

Selamlar,

Sayfa1 in kod bölümüne aşağıdaki kodu uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$L$13" Then Exit Sub
    If Target <> "" Then
    Set S2 = Sheets("Sayfa2")
    S&#252;tun = 1
    For X = 1 To 11
    S2.Cells(9, S&#252;tun) = Mid(Target, X, 1)
    S&#252;tun = S&#252;tun + 1
    Next
    Set S2 = Nothing
    End If
End Sub

 

[Orion1]

Merhaba.
Sayın Cost_Control cevap vermiş gerçi.
Alternatif açısından aşağıdaki koduda kullanabilirsiniz.

Sub kimlik_no_ayir()
Dim kimlik_no As Byte
Sheets("Sayfa1").Select
kimlik_no = Len(Range("L13").Value)
For i = 1 To kimlik_no
    Sheets("Sayfa2").Cells(9, i).Value = Mid(Range("L13").Value, i, 1)
Next
MsgBox "Ayıklama Yapıldı."
End Sub

 

[gezgin-49]

Sayın üstadlarım Cost_Control ve Sezar çok teşekkür ederim, ellerinize, emeğinize sağlık Allah razı olsun, tuttuğunuzu altın etsin, saygılar sunuyorum.