Soru Sütunda yer alan dataları satırlara yazdırma

[cetinosq]

Herkese merhaba dostlar,

Elimde aşağıdaki örnekte görüldüğü gibi bir data mevcut (data örnek olması açısından rastgele oluşturulmuştur).
Bu datada satırlarda İl, İlçe yer alıyor. Sütunlarda ise aylık bazda bu ilçelerdeki tahmini nüfus miktarları yer alıyor.

İhtiyaç ise sütunlarda yer alan ayları satırlara yazdırmak, destekleriniz için şimdiden teşekkürler.

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodu bir modüle kopyalayıp çalıştırın.

Veriler Sayfa1'de olmalı
Sayfa2'de İl, İlçe, Ay, Nüfus başlıkları olmalı

Sub Test()
    Dim Bak As Long
    Dim Syf_1 As Worksheet, Syf_2 As Worksheet
    Dim Say As Long
    
    Application.ScreenUpdating = False
    Set Syf_1 = Worksheets("Sayfa1")
    Set Syf_2 = Worksheets("Sayfa2")
    For Bak = 2 To Syf_1.Cells(Rows.Count, "A").End(xlUp).Row
    
        Say = Syf_2.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Syf_2.Range("A" & Say & ":A" & Say + 11).Value = Syf_1.Cells(Bak, "A").Value
        Syf_2.Range("B" & Say & ":B" & Say + 11).Value = Syf_1.Cells(Bak, "B").Value
        Syf_1.Range("C1:N1").Copy
        Syf_2.Range("C" & Say & ":C" & Say + 11).PasteSpecial Transpose:=True
        Syf_1.Range("C" & Bak & ":N" & Bak).Copy
        Syf_2.Range("D" & Say & ":D" & Say + 11).PasteSpecial Transpose:=True
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "Tamamlandı.", vbInformation
End Sub

 

[cetinosq]

Teşekkür ederim, emeğinize sağlık