tek satır bilgilerini iki satıra aktarma

[baron07]

kolay gelsin arkadaşlar
ekteki dosyada tek satırda kayıtlı kişi bilgilerini sayfa1 deki iki satırdan oluşan hücrelere bilgileri kaydetmek istiyorum yardımcı olursanız memnun olurum

 

[veyselemre]

[vb:1:91586d25f1]Sub aktar()
Sheets("sayfa2").Select
For x = 2 To [a65536].End(3).Row
satir1 = (x * 2) - 1
satir2 = satir1 + 1

Sheets("sayfa1").Cells(satir1, "a") = Cells(x, "a")
Sheets("sayfa1").Cells(satir1, "b") = Cells(x, "b")
Sheets("sayfa1").Cells(satir1, "c") = Cells(x, "c")
Sheets("sayfa1").Cells(satir1, "d") = Cells(x, "d")
Sheets("sayfa1").Cells(satir1, "e") = Cells(x, "e")
Sheets("sayfa1").Cells(satir1, "f") = Cells(x, "f")
Sheets("sayfa1").Cells(satir1, "g") = Cells(x, "g")
Sheets("sayfa1").Cells(satir2, "g") = Cells(x, "h")
Sheets("sayfa1").Cells(satir1, "h") = Cells(x, "I")
Sheets("sayfa1").Cells(satir2, "h") = Cells(x, "J")
Sheets("sayfa1").Cells(satir1, "I") = Cells(x, "K")
Sheets("sayfa1").Cells(satir2, "I") = Cells(x, "L")
Sheets("sayfa1").Cells(satir1, "j") = Cells(x, "m")
Sheets("sayfa1").Cells(satir2, "j") = Cells(x, "n")
Sheets("sayfa1").Cells(satir1, "k") = Cells(x, "o")
Sheets("sayfa1").Cells(satir2, "k") = Cells(x, "p")
Next
End Sub
[/vb:1:91586d25f1]

 

[baron07]

teşekkürler sayın veyselemre
kodlar tam istediğim gibi.