Sıra Numarasını Hücreye Yazdırıp, Her dört satırı, sayfa2'ye kesip sırasıyla yapıştır

[ottoman71]

Arkadaşlar merhaba.
Ekteki dosyada A1 ile J4000 arasına, sıra numarasını makro ile yazdırdım.
Bundan sonraki aşama her 4'üncü satırı sheet2'ye yapıştırmak. Fakat bi döngü kuramadım.
Yani: "A4:J4", A8:J8", ""A12:J12"......."A4000:J4000" satırlarını peş peş sheet2'ye kesip yapıştıracak.
Yardımcı olabilir misiniz?

 

[ottoman71]

Arkadaşlar, yardımcı olabilir misiniz?

 

[ottoman71]

Arkadaşlar yardım edecek kimse yok mu?

 

[Ömer]

Merhaba,

Sorunuz net değil.

Sub AtlaYaz()
 
    Dim S2 As Worksheet, i As Long
    Set S2 = Sheets("Sheet2")
 
    Sheets("Sheet1").Select
    For i = 4 To Cells(Rows.Count, "A").End(xlUp).Row Step 4
        Range("A" & i & ":J" & i).Copy S2.Range("A" & i)
    Next i
 
End Sub

yada;

Sub AtlaYazZ()
 
    Dim S2 As Worksheet, i As Long, sat As Long
    Set S2 = Sheets("Sheet2")
 
    Sheets("Sheet1").Select
    sat = 1
    For i = 4 To Cells(Rows.Count, "A").End(xlUp).Row Step 4
        Range("A" & i & ":J" & i).Copy S2.Range("A" & sat)
        sat = sat + 1
    Next i
 
End Sub

İstediğiniz bu mu?

.

 

[uzmanamele]

merhaba

bu işinizi görür mü?

Sub kes_yapistir()
Set s1 = Sheets("sheet1")
Set s2 = Sheets("sheet2")
x = 1
For i = 4 To 4000 Step 4
s1.Range("a" & i & ":" & "j" & i).Cut s2.Range("a" & x)
x = x + 1
Next
End Sub

 

[ottoman71]

Merhaba,

Sorunuz net değil.

İstediğiniz bu mu?

.

Ömer Hocam teşekkür ederim. İstediğim gibi.
Ellerinize sağlık.
İyi çalışmalar.

 

[ottoman71]

merhaba

bu işinizi görür mü?

Hocam teşekkür ederim. İşimi gördü. Ömer Hocam ve sizinki ile bir kaç alternatif oldu elimde.
İyi çalışmalar.