Satırlardaki değerleri Sütuna getirme

[torque]

Herkese Merhaba,

Aşağıdaki Tablo-1'de bulunan D ve E sütunlarını, A,B ve C sütunları sabit kalacak şekilde "değerleri" aynı sütuna ve "başlıkları (D ve E)" aynı sütuna Tablo-2'deki gibi nasıl getirebilirim?
Yardımcı olabilirseniz çok sevinirim.
Teşekkürler.

 

[ÖmerBey]

Merhaba,
Sayfanın yedeğiniz aldıktan sonra aşağıdaki kodu deneyiniz.

Sub kod()
son = Cells(Rows.Count, "A").End(3).Row
dz1 = Range("A1:E" & son * 2)
dz2 = Range("A2:E" & son)
Range("A1:E" & son).ClearContents
For a = LBound(dz2) To UBound(dz2)
    x = x + 2
    For b = 1 To 4
        dz1(x, b) = dz2(a, b)
        dz1(x + 1, b) = dz2(a, b)
    Next
    dz1(x + 1, 4) = dz2(a, 5)
    dz1(x, 5) = dz1(1, 4)
    dz1(x + 1, 5) = dz1(1, 5)
Next
dz1(1, 5) = ""
dz1(1, 4) = ""
Range("A1:E" & son * 2) = dz1
End Sub

 

[torque]

Öncelikle yardımcı olduğunuz için çok teşekkür ederim. Değerler geldi fakat değerlerin başlıklarını da ("D" ve "E") değerlerin hemen yanındaki hücreye getirebilir miyiz?

 

[ÖmerBey]

Yukarıdaki kodu güncelledim, deneyiniz...