Yatay sütunu Dikey konuma getirirken bazı kodları çoklamak

[aykut12344]

Merhaba arkadaşlar,

Yatay sütunları dikeye getirme ihtiyacım var. Bu noktada tarih ve ürün kodlarını ve bir alt kodu çoklamaya ihtiyacım var. ek örnekte net bir şekilde anlatmaya çalıştım.

yardımcı olabilirseniz çok sevinirim. şimdiden çok teşekkürler

http://dosya.co/yb3tlqalnfxg/Sütunu_Satıra_Çevirme.xlsx.html

 

[Ömer BARAN]

Merhaba.
Aşağıdaki kod, Sayfa1'de A:AL sütunlarındaki verileri, istenilen biçimde Sayfa2 A : D sütunlarına listeler.

Sub YATAYI_DIKEYE_CEVIR_BRN()
Set s1 = Sheets("Sayfa1"): Set s2 = Sheets("Sayfa2")
s2.Cells.Clear
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To s1.Cells(Rows.Count, "A").End(3).Row
    s2sat = s2.Cells(Rows.Count, "A").End(3).Row + 1
    For sut = 3 To 38
        s2.Cells(s2sat + sut - 3, "A") = s1.Cells(sat, "A")
        s2.Cells(s2sat + sut - 3, "B") = s1.Cells(sat, "B")
        s2.Cells(s2sat + sut - 3, "C") = s1.Cells(1, sut)
        s2.Cells(s2sat + sut - 3, "D") = s1.Cells(sat, sut)
    Next
Next
s2.[A1] = s1.[A1]: s2.[B1] = s1.[B1]: s2.[C1] = "TARİH": s2.[D1] = "ADET"
s2.[C:C].NumberFormat = "mm/dd/yyyy": s2.[D:D].NumberFormat = "#,##0.00"
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
s2.Columns.AutoFit: s2.Activate
MsgBox "işlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub