Hücrede Bulunan Verileri Satırlara Bölmek

[YAVUZSs]

Merhabalar;

Elimde şöyle demosu olan 100 bin+ satırlık bir tablo var.



Bu tabloyu alttaki şekle getirmek istiyorum. Bunu nasıl yapabilirim?



Dosyayı da ekledim.

 

[Muzaffer Ali]

Merhaba.
Deneyiniz.

Sub test()
    Dim Bak As Long
    Dim Satir As Variant
    Dim Sutun As Integer
    Dim StrSay As Integer
    Dim BakStr As Integer
    Dim Say As Long
    Application.ScreenUpdating = False
    For Bak = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        StrSay = UBound(Split(Cells(Bak, "B"), Chr(10)))
        Say = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Rows(Bak + 1 & ":" & Bak + 1 + StrSay).Insert
        
        For Sutun = 1 To 11
            Satir = Split(Cells(Bak, Sutun), Chr(10))
            Range(Cells(Bak + 1, Sutun).Address & ":" & Cells(Bak + 1 + StrSay, Sutun).Address).Value = WorksheetFunction.Transpose(Satir)
        Next
        Satir = Empty
        Rows(Bak).Delete
    Next
    Cells.EntireRow.AutoFit
    Application.ScreenUpdating = True
    MsgBox "Tamamlandı."
End Sub

 

[YAVUZSs]

Çok teşekkür ederim , tam aradığım şey.