Tabloyu çevir

[Mtn]

Merhabar ekte gönderdiğim excel dosyası sayfa1 verileri sayfa2 gibi olmasını istiyorum nasıl bir makro olabilir.
Örnek Dosya

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Cevir()

    Dim S2 As Worksheet, sat As Long, i As Long, j As Integer

    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select
    S2.[A:C].Clear
    
    sat = 1
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = 4 To Cells(i, Columns.Count).End(xlToLeft).Column
            If Cells(i, j) <> "" Then
                S2.Cells(sat, "A") = Cells(i, "A")
                S2.Cells(sat, "B") = Cells(i, "B") & " " & Cells(i, "C")
                S2.Cells(sat, "C") = Cells(i, j)
                sat = sat + 1
            End If
        Next j
    Next i
    
    S2.Select
    
End Sub

 

[Mtn]

Merhaba,

Bu şekilde deneyin.

Sub Cevir()

    Dim S2 As Worksheet, sat As Long, i As Long, j As Integer

    Set S2 = Sheets("Sayfa2")
   
    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select
    S2.[A:C].Clear
   
    sat = 1
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = 4 To Cells(i, Columns.Count).End(xlToLeft).Column
            If Cells(i, j) <> "" Then
                S2.Cells(sat, "A") = Cells(i, "A")
                S2.Cells(sat, "B") = Cells(i, "B") & " " & Cells(i, "C")
                S2.Cells(sat, "C") = Cells(i, j)
                sat = sat + 1
            End If
        Next j
    Next i
   
    S2.Select
   
End Sub

Teşekkürler