sütundaki verileri satırlara makro ile aktarma

[sirkülasyon]

Regaib kandilimiz Mübarek Olsun.

Selamün Aleyküm.
Değerli Ağabeylerim.
Sayfa2(Bilgi Girişi) sayfasında bulunan
1 - B7:B120 aralığında olan verileri
Sayfa7(Sayfa1) olan sayfanın A1 hücresinden başlamak üzere satırlara
2 - C7:C120 aralığında olan verileri
Sayfa7(Sayfa1) olan sayfanın A2 hücresinden başlamak üzere satırlara
3 - D7: D120 aralığında olan verileri
Sayfa7(Sayfa1) olan sayfanın A3 hücresinden başlamak üzere satırlara
4 - E7:E120 aralığında olan verileri
Sayfa7(Sayfa1) olan sayfanın A4 hücresinden başlamak üzere satırlara
5 - F7:F120 aralığında olan verileri
Sayfa7(Sayfa1) olan sayfanın A5 hücresinden başlamak üzere satırlara
Makro ile butona bağlayarak aktarmak istiyorum. Yardımcı olabilir misiniz?

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Aktar()

    Set Sb = Sheets("Bilgi Girişi")
    Set S1 = Sheets("Sayfa1")
    
    Application.ScreenUpdating = False
    S1.Range("A1:DJ5").ClearContents
    
    For i = 2 To 6
        Sb.Cells(7, i).Resize(120 - 6, 1).Copy
        S1.Cells(i - 1, "A").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Next i
    
    S1.Select
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

.

 

[sirkülasyon]

Ömer Abi
Ellerine Sağlık. Teşekkür Ederim