Yatay Satırları Dikey yapıp Tekrar Ettirme hk.

[IRONSELF]

Arkadaşlar merhaba,

sitede arama yaptığımda çok fazla bi sonuca ulaşamadım. Ekte anlatmaya çalıştım yardımcı olur musunuz.

iyi çalışmalar.

 

[Muzaffer Ali]

Merhaba.

Sub test()
    Dim Bak As Long
    Dim Say As Long
    
    For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Say = Cells(Rows.Count, "J").End(xlUp).Row + 1
        Range("A" & Bak).Copy Range("J" & Say & ":J" & Say + 2)
        Range("B" & Bak & ":D" & Bak).Copy
        Range("K" & Say).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Next
    Application.CutCopyMode = False
    MsgBox "Tamamlandı."
End Sub

 

[IRONSELF]

Çok teşekkür ederim sutunu 3 değilde daha fazla yapsak nası artırırız acaba ?

 

[Muzaffer Ali]

Range("A" & Bak).Copy Range("J" & Say & ":J" & Say + 2)

2 yerine sütun sayısı - 1 yazın. Yani sütun sayısı 10 ise 9 yazın.

Range("B" & Bak & ":D" & Bak).Copy

Örnekte veriler "B : D" aralığındaydı bunu da kendi sütunlarınıza göre değiştirin.

 

[IRONSELF]

Çok teşerkkür ederim

 

[Muzaffer Ali]

Rica ederim. Kolay kelsin.