ALT+ENTER ile hazırlanmış Listeyi tek tek hücrelere atmak

[titris]

Arkadaşlar;

Benim yapmak istediğim tek bir hücre içinde yer alan bazen 1 bazen 2 bezende 10 gibi değişik sayıda ALT+ENTER şeklinde girilmiş olan listeyi tek tek hücrelere almak istiyorum bunu makro veya fonksiyon ile nasıl yapabilirim

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub VERİLERİ_DÜZENLE()
    Dim HÜCRE As Range, AYIR As Variant, X As Integer, SATIR As Long
    
    Columns("D:D").Clear
    
    If WorksheetFunction.CountA(Columns("A:A")) = 0 Then Exit Sub
    
    For Each HÜCRE In Columns("A:A").SpecialCells(xlCellTypeConstants, 23)
        AYIR = Split(HÜCRE.Value, Chr(10))
            For X = 0 To UBound(AYIR)
                SATIR = SATIR + 1
                Cells(SATIR, "D") = AYIR(X)
            Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[titris]

Teşekkür

Çok Teşekkürler Arkadaş İşimi hayda hayda gördü Emeğin için sağol.