How to copy every row except every nth - vba

Question

In excel I would like to copy the date from one sheet to another one using macro in a way that it will copy everything until row 9, then it will skip row 10 and copy row 11 and 12, and then skip one again.
So it should not copy row 10,13,16,19, etc..
I have the following code
Dim i As Integer
i = 9
J = 1
K = 9
Do While i < 5000
If J = 3 Then
J = 0
Sheets("sheet1").Select
Rows(i).Select
Selection.Copy
Sheets("sheet2").Select
Cells(K, 1).Select
ActiveSheet.Paste
K = K + 1
End If
J = J + 1
i = i + 1
Loop
This code is copying everything till the 8th row and then every 3rd, can somebody help me how to modify that code?

Answer 1

Fastest way will be to Copy >> Paste the entire rows once, according to your criteria.
You can achieve it by merging all rows that needs to be copies to a Range object, in my code it's CopyRng, and you do that by using Application.Union.
Code
Option Explicit
Sub CopyCertailRows()
Dim i As Long
Dim CopyRng As Range
Application.ScreenUpdating = False
With Sheets("sheet1")
' first add the first 8 rows to the copied range
Set CopyRng = .Rows("1:8")
For i = 9 To 5000
If (i / 3) - Int(i / 3) <> 0 Then ' don't add to copied range the rows that divide by 3 without a remainder
Set CopyRng = Application.Union(CopyRng, .Rows(i))
End If
Next i
End With
' copy >> paste in 1- line
CopyRng.Copy Destination:=Sheets("sheet2").Range("A9")
Application.ScreenUpdating = True
End Sub

Answer 2

You could simplify this massively by using If i < 10 Or (i - 1) Mod 3 <> 0 Then... which will select the rows you're interested in. Like so:
Dim i As Integer, j As Integer
j = 0
Dim sourceSht As Worksheet
Dim destSht As Worksheet
Set sourceSht = Sheets("Sheet1")
Set destSht = Sheets("Sheet2")
For i = 1 To 5000
If i < 10 Or (i - 1) Mod 3 <> 0 Then
j = j + 1
sourceSht.Rows(i).Copy destSht.Rows(j)
End If
Next
Personally, I'd turn screen updating and calculations off before running this and enable them again after to reduce the time needed to perform the loop.
Also, as Michał suggests, unless your dataset happens to be exactly 5,000 rows, you might want to 'find' the last row of data before starting to further reduce the time needed.

Answer 3

All necessary comments in code:
'declare all variables, be consistent with lower/uppercases, use Long instead of Integeer (its stored as long anyway)
'use meaningful variable names
Dim i As Long, copyUntil As Long, currentRow As Long
copyUntil = 9
currentRow = 1
'copy all rows until we reach 9th row
For i = 1 To copyUntil
Sheets("sheet1").Rows(i).Copy
Sheets("sheet2").Rows(currentRow).Paste
currentRow = currentRow + 1
Next
'now we will takes steps by 3, on every loop we will copy i-th row and next one, third will be omitted
'we also use currentRow variable to avoid empty rows in sheet2
'also, 5000 seems wrong, I'd recommend to determine last row, until which we will loop
'last row is often determined like Cells(Rows.Count, 1).End(xlUp).Row
For i = copyUntil + 2 To 5000 Step 3
Sheets("sheet1").Rows(i).Copy
Sheets("sheet2").Rows(currentRow).Paste
currentRow = currentRow + 1
Sheets("sheet1").Rows(i + 1).Copy
Sheets("sheet2").Rows(currentRow).Paste
currentRow = currentRow + 1
Next

Answer 4

This code will only paste values. Let me know if any questions or if you really, really need the formatting I can tweak it.
Sub DoCopy()
'This code is pretty much specifit to your request/question, it will copy 1-9, skip 10, 13, 16....
'i for the loop, x for the row that will not be added, y to paste on the second sheet
Dim i, x, y As Long, divn As Integer
For i = 1 To 5000
If i < 10 Then
y = y + 1
Sheets("Sheet1").Rows(i).Copy
Sheets("Sheet2").Range("A" & y).PasteSpecial ''Paste values only
ElseIf i >= 10 Then
x = i - 10
If x Mod 3 <> 0 Then
y = y + 1
Sheets("Sheet1").Rows(i).Copy
Sheets("Sheet2").Range("A" & y).PasteSpecial ''Paste values only
Else
'Do nothing
End If
End If
Next i
End Sub