yatay sütundaki datayı dikey sütun haline getirmek

[aykut12344]

arkadaşlar, aşağıdaki ekran görüntüsünde olduğu gibi yatayda bulunan datayı dikey format olarak değiştirme ihtiyacım var.
Ekran görüntüsü içerisinde detaylı olarak anlatmaya çalıştım. 14 binden fazla 15 bine yakın bir yatay datam var. bu datanın ekran görüntüsünün hemen altında olduğu gibi dikey hale getirmem gerekiyor.

Şimdiden teşekkürler.

https://hizliresim.com/PDENMO

 

[anemis]

Basitçe kopyalayın,
dikey yapıştırmak istediğiniz hücreye sağ tık yapıştırma seçeneklerinde işlemi ters çevir kutucuğunu işaretleyin..

Veriniz çok fazla olduğundan epey yavaş olacaktır ama.

 

[aykut12344]

bu şekilde yaptığımda alt grup bazında sağ tarafa doğru kopyalıyor. benim istediğim ise ekran görüntüsüne dikkatli bakarsanız dataları birde alt alta getirmek.

 

[Ömer BARAN]

Merhaba.

Sorularınızı, ekran görüntüsü yerine gerçek belgenizin özel bilgi içermeyen küçük boyutlu bir kopyası
şeklinde hazırlayacağınız örnek belge üzerinden sorunuz.
Örnek belge yükleme yöntemine ilişkini kısa açıklama cevabımın altındaki İMZA bölümünde var.

Belgenizdeki;
-- orijinal verilerin Data isimli sayfada olduğu ve başlıkların 2'nci satırda, A:N sütun aralığında olduğu,
-- verilerin Yeni isimli sayfada 2'nci satırdan itibaren A sütun aralığına aktarılmak istenildiği,
varsayılırsa aşağıdaki kod istenilen işlemi yapacaktır.
.

[B][COLOR="blue"]Sub DIKEY_AKTAR()[/COLOR][/B]
Set d = Sheets("[B][COLOR="Red"]Data[/COLOR][/B]"): Set y = Sheets("[B][COLOR="red"]Yeni[/COLOR][/B]")
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
If y.Cells(Rows.Count, 1).End(3).Row > 1 Then _
    y.Range("A2:D" & y.Cells(Rows.Count, 1).End(3).Row).ClearContents
For dsat = 3 To d.Cells(Rows.Count, 1).End(3).Row
    For dsut = 3 To 14
        ysat = y.Cells(Rows.Count, 1).End(3).Row + 1
        y.Cells(ysat, 1) = d.Cells(dsat, 1): y.Cells(ysat, 2) = d.Cells(dsat, 2)
        y.Cells(ysat, 3) = d.Cells(2, dsut): y.Cells(ysat, 4) = d.Cells(dsat, dsut)
    Next
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[Ziynettin]

Alternatif, dizi calışması.

Sub Tablo()
son = Cells(Rows.Count, 1).End(3).Row
a = Range("A2:N" & son).Value
ReDim b(1 To UBound(a) * 12, 1 To 4)
    For i = 2 To UBound(a)
        say = say + 1
        For j = 0 To 11
            b(say + j, 1) = a(i, 1)
            b(say + j, 2) = a(i, 2)
            b(say + j, 3) = a(1, j + 3)
            b(say + j, 4) = a(i, j + 3)
        Next j
        say = say + 11
    Next i
Range("P2:S" & Rows.Count).ClearContents
[P2].Resize(, 4) = Array(a(1, 1), a(1, 2), "Ay", "Adet")
[P3].Resize(say, 4) = b
MsgBox "İşlem bitti.", vbInformation
End Sub