dikey aktarma

[BESST]

Merhaha Arkadaşlar

Ek'te gönderdiğim örnekte "sayfa1" deki verileri "özet" sayfasındaki hale dönüştürmem gerekiyor ve "sayfa1" de şimdilik A,B,C,D olan sütunlar artabilir. bu tip bir çok sayfa bulunmakta en kısa yoldan bunu nasıl halledebilirim , bana yardımcı olurmusunuz.

 

[BESST]

Arkadaşlar sorun halloldu ilgili kodu aşağıya ekliyorum, belki lazım olan biri olur.
iyi çalışmalar



Sub aktar()
haftasay = WorksheetFunction.CountA(Sayfa1.Range("B2:b65536")) + 1


For n = 3 To haftasay + 1


liste = WorksheetFunction.CountA(Sayfa1.Range("B2:ıv2")) + 1


For m = 3 To liste

f = WorksheetFunction.CountA(Sayfa2.Range("A1:a65536")) + 1
Sayfa2.Cells(f, 1).Value = Sayfa1.Cells(2, m).Value
Sayfa2.Cells(f, 2).Value = Sayfa1.Cells(n, 2).Value
Sayfa2.Cells(f, 3).Value = Sayfa1.Cells(n, m).Value

Next m
Next n

End Sub