1 hücrenin içindeki metinleri alarak sutunlara yerleştirebilen makro yapabilirmiyiz

[senerozun]

bu excel tablosunda yapmaya çalıştığım "sayfa1" deki tabloyu " j " sutunundaki verileri alarak
excel sayfasında gösterdiğim örnekteki gibi bu verileri
sutunlarda gerekli yerlerine yazdırmak istiyorum

yani: veriyi " j " sutunundan alarak ad ,sayad, baba adı, kısımlarını doldurmak istiyorum
veriyi gerekli yerlere yerleştirdikten sonra gri dolgu rengi ile belirttirmek istiyorum.

makro ile böyle bir çalışma yapabilirmiyiz. büyük tablolarda bunu elle girmek çok vakit alıyor. eğer bunu makroyla yapabilirsek çok sevinirim. şimdiden çok teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub VERİLERİ_DÜZENLE()
    Dim X As Long, VERİ() As String, SATIR As Long, Y As Long, SAY As Byte, KELİME() As String
    
    For X = 13 To ActiveSheet.UsedRange.Rows.Count
        If Cells(X, "J") <> "" Then
            SAY = 0
            VERİ = Split(Cells(X, "J"), ",")
            SATIR = UBound(VERİ()) + 1
            Range("A" & X + 1 & ":R" & X + SATIR).Insert Shift:=xlDown
            Range("A" & X + 1 & ":R" & X + SATIR).Interior.ColorIndex = 15
            
            For Y = X + 1 To X + SATIR
                If VERİ(SAY) <> "" Then KELİME = Split(VERİ(SAY), " ")
                Cells(Y, "E") = KELİME(0)
                Cells(Y, "F") = Replace(KELİME(1), Chr(10), "")
                Cells(Y, "G") = Replace(Replace(KELİME(2), Chr(10), ""), ":", "")
                SAY = SAY + 1
            Next
            X = X + SATIR - 1
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub