For-Next ve Loop döngüleri

[Yüksel Varlı]

Merhaba,
Aşağıdaki kodlarla "veri" sayfasındaki numaraları, "devam" sayfasında A1 den başlayarak 17 satır aralıklarla yazdırmak istiyorum. Ama başaramadım.
Selamlar.

Sub no()
Dim son As Integer
Sheets("veri").Select
son = WorksheetFunction.CountA(Sheets("veri").Range("B:B"))
For z = 1 To son
Cells(z, 2).Select
Selection.Copy

Sheets("devam").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(17, 0).Select
ActiveSheet.Paste
Loop

Next z
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub no()
Dim son As Integer
Sheets("veri").Select
son = WorksheetFunction.CountA(Sheets("veri").Range("B:B "))
For z = 1 To son
sheets("devam").cells(c+1,"a")=Cells(z, 2)
c=c+17
Next z
End Sub

 

[Yüksel Varlı]

Sevgili leventm,
Tek döngünün içerisinde yapılabileceğini hiç düşünmemiştim. Çok güzel oldu. Teşekkürler.