Sütunları Satırlara Çevirme

[o2l3m]

Merhaba;

Örnekteki gibi;
Veri içeren tarih sütunlarını satırlara dağıtmak için kod ihtiyacımız var. Destek olacak arkadaşa şimdiden teşekkür ederim.

 

[Ömer]

Merhaba,

Veriler Sayfa2 de listelenir. Sayfa2 de ki başlıkları yazarsınız.

Sub test()
  
    Dim i As Long, j As Integer, S1 As Worksheet, S2 As Worksheet, sat As Long
  
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
  
    Application.ScreenUpdating = False
    S2.Select
    Range("A2:C" & Rows.Count).ClearContents
  
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row
        j = S1.Cells(i, Columns.Count).End(xlToLeft).Column
        S1.Cells(i, "A").Copy Cells(sat, "A").Resize(j - 1, 1)
        S1.Cells(1, "B").Resize(1, j - 1).Copy
        Cells(sat, "C").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=True
        S1.Cells(i, "B").Resize(1, j - 1).Copy
        Cells(sat, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=True
        sat = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Next i

    Range("C:C").NumberFormat = "dd/mm/yyyyy"
    Application.CutCopyMode = False: [A1].Select
    Application.ScreenUpdating = True
  
End Sub

 

[o2l3m]

Çok teşekkürler, Emeğinize sağlık