macro to cut/ paste ever nth row

[psu2000]

I'm thinking there is a really simple solution that I am missing for
this problem. I have an excel file with a couple thousand records. I
need to be able to select every nth row (starting with row 1), cut
that row from the sheet and paste it into sheet 2, continuing until it
reaches an empty row. Example:
A B C
1 u t s
2 e r q
3 c p u
4 c o t
5 v u b
6 9 7 8
7 b 5 8
8 o e 3
9 8 4 c
10 i e b
11 9 e 4

Using 5 as the nth, the macro would cut rows 1, 6, 11, etc.... into
sheet 2. Sheet 1 would look like:
A B C
1 e r q
2 c p u
3 c o t
4 v u b
5 b 5 8
6 o e 3
7 8 4 c
8 i e b


And sheet 2 would have
A B C
1 u t s
2 9 7 8
3 9 e 4



I have the following code which will do copy the nth rows, but it
leaves them in the original document.

Sub copyNthRow()
Dim j As Integer
Dim i As Integer
Dim NthRow As Integer

NthRow = 5
j = Cells.SpecialCells(xlLastCell).Row
Range("A1").Select
Do Until ActiveCell.Row > j
Rows(ActiveCell.Row).Copy
Sheets("sheet3").Range("A1").Offset(i, 0).PasteSpecial
(xlValues)
i = i + 1
ActiveCell.Offset(NthRow, 0).Select
Loop
End Sub

I need a way to remove them from that document. I'm willing to run two
macros if that's what I need to do, one to copy and then one to cut...
any help:

 

[Dave Peterson]

I would insert a helper column in column A.
Then put
=mod(row(),10)
in A1 and drag down 2000 rows.

Then apply data|filter|autofilter to that column.
Show just the 1's.
Select that visible range and copy to the other sheet.

Delete column A from both sheets.

 

[Guest]

Hi psu2000-

Here's your code with one line (two statements) added. Seems to work...

Sub copyNthRow()
Dim j As Integer
Dim i As Integer
Dim NthRow As Integer

NthRow = 5
j = Cells.SpecialCells(xlLastCell).Row
Range("A1").Select
Do Until ActiveCell.Row > j
Rows(ActiveCell.Row).Copy
Sheets("sheet3").Range("A1").Offset(i, 0).PasteSpecial (xlValues)
ActiveCell.EntireRow.Delete: j = j - 1
i = i + 1
ActiveCell.Offset(NthRow - 1, 0).Select
Loop
End Sub