Bir Listedeki Verileri Çoğaltma

[misskean]

Değerli Excel Forumdaşlarım,

Bir tablom var ve bu tablo için planım şu şekildedir. bir hücredeki veriyi alt alta 5 adet yazıcak. ama listede bir sürü malzeme var. bu konuyla ilgili desteğinizi rica edicektim.


A sütununa yazıcak yeni verilerimi. Benim çoğaltılacak verilerim ise R ve S sütununda bulunmaktadır. R ve S sütunundan kaydı alıp 5 adet yazıcak.
sonrada diğer kaydı gene aynı bu şekilde 5 er 5 er çoğaltacaktır.

A Sütunu B sütunu R sütunu S sütunu
123456 demir 123456 demir
123456 demir 234567 bakır
123456 demir 345678 çelik
123456 demir
123456 demir
234567 bakır
234567 bakır
234567 bakır
234567 bakır
234567 bakır
345678 çelik
345678 çelik diye devam edicek.

Şimdiden teşekkür ederim.

 

[Mustafa MUTLU]

Aşağıdaki kodu denermisiniz..

Sub AKTAR()
Dim MM, MSTF, MSTF1
Application.ScreenUpdating = False
Range("A:B").ClearContents
MM = 2
For MSTF = 2 To Cells(65536, "R").End(xlUp).Row
For MSTF1 = 1 To 5
Cells(MM, "A") = Cells(MSTF, "R")
Cells(MM, "B") = Cells(MSTF, "S")
MM = MM + 1
Next
Next
Application.ScreenUpdating = True
MsgBox "verileri 5 er adet aktardım..", vbExclamation, "Mustafa MUTLU 0 533 740 45 49"
End Sub

 

[Mustafa MUTLU]

Sub AKTAR()
Dim MM, MSTF, MSTF1
Application.ScreenUpdating = False
Range("A:B").ClearContents
MM = 2
For MSTF = 2 To Cells(65536, "R").End(xlUp).Row
For MSTF1 = 1 To 5
Cells(MM, "A") = Cells(MSTF, "R")
Cells(MM, "B") = Cells(MSTF, "S")
MM = MM + 1
Next
MM = MM + 1
Next
Application.ScreenUpdating = True
MsgBox "verileri 5 er adet aktardım..", vbExclamation, "Mustafa MUTLU 0 533 740 45 49"
End Sub

Attığın mesajda boş satır istemişin.
Şimdi Her 5 kayıttan sonra bir boş satır bırakacak..