Soru ham verılerı tablo halıne getırmek

[kakara]

Merhaba ustadlarım elımdekı ham verılerı tablo seklıne getırmek ıstıyorum. detaylı bılgılerı ektekı dosyada paylaştım ilginiz ve yardımlarınız için şimdiden teşekkur ederım.

https://dosyam.org/1P5J/verı_calısması.xlsx

 

[kakara]

yardımcı olabılecek varsa sevınırım

 

[veyselemre]

Sub test()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Dim s1 As Worksheet, s2 As Worksheet, _
    i&, ii%, sat&, veri(), bl
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    s2.Cells.Clear
    For i = 1 To 3
        s2.Cells(1, i).Resize(2).MergeCells = True
    Next i

    s2.Range("A1:L2").HorizontalAlignment = xlCenter
    s2.Range("A3:L3").Interior.Color = vbRed
    
    veri = s1.Range("A10:M" & s1.Cells(Rows.Count, 1).End(3).Row).Value
    For i = LBound(veri) To UBound(veri)
        sat = (i - 1) * 3 + 1
        For ii = 1 To 3
            s2.Cells(sat, ii).Value = veri(i, ii)
        Next ii
        
        bl = Split(veri(i, 4), "-")
        s2.Cells(sat + 1, 4).Resize(, 9).Value = 0
        For ii = LBound(bl) To IIf(UBound(bl) > 8, 8, UBound(bl))
            s2.Cells(sat, ii + 4).Value = LCase(bl(ii))
            s2.Cells(sat + 1, ii + 4).Value = veri(i, ii + 5)
        Next ii
    Next i
    s2.Range("A1:L3").Copy

    With s2.Range("A1:L" & sat + 2)
        .PasteSpecial xlFormats
        .BorderAround xlContinuous, xlMedium
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

 

[kakara]

@veyselemre ustadım sadece bırlestırme calısmıyor ama bu sekılde bıle ısımı görur ılgınız ıcın tesekkurler