sutunları satıra çevirme

[neco_can]

Değerli dostlar merhaba, benim sorum şu, elimde yaklasık 50.000 adet veri var bu verilerin bir kısmını ekte sizinle paylaşıyorum.
Aynı acente gurubunda bulunan teknik personelin yan yana sıralamasını istiyorum. kırmızı ıle belirttiğim alanlar

 

[Emir Hüseyin Çoban]

. . .

Dosyanız ektedir.

Sub kod()
    Application.ScreenUpdating = False
    
    süt = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    If süt <= 8 Then süt = 9
    
    Range(Cells(2, "I"), Cells(Rows.Count, süt)).ClearContents
    
    For i = 2 To Cells(Rows.Count, "H").End(3).Row
        
        If Cells(i, "G") <> "" Then
            satır = Cells(i, "G").Row
            sütun = 9
        End If
        
        If Cells(i, "G") = "" Then
            Cells(satır, sütun) = Cells(i, "H")
            sütun = sütun + 1
        End If
        
    Next i
    
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

 

[neco_can]

büyük insansın ellerine sağlık