I have a worksheet that has over 1,000 rows with no labels. The first three
columns have the same labels. Here is what I would like to do:

I would like to create 3(three) worksheets by picking the following:

1St group (tab) would include rows 1, 4, 7, 10, 13 etc. adding the 3rd row
to the end.

2nd group (tab) would include rows 2, 5, 8, 11, 14, etc. adding the 3rd row
to the end

3rd group (tab) would include rows 3, 6, 9, 12, etc. adding the 3rd row to
the end.

This code is very simple, but works.

"Beep Beep" wrote:

I have a worksheet that has over 1,000 rows with no labels. The first three
columns have the same labels. Here is what I would like to do:

I would like to create 3(three) worksheets by picking the following:

1St group (tab) would include rows 1, 4, 7, 10, 13 etc. adding the 3rd row
to the end.

2nd group (tab) would include rows 2, 5, 8, 11, 14, etc. adding the 3rd row
to the end

3rd group (tab) would include rows 3, 6, 9, 12, etc. adding the 3rd row to
the end.

This code is very simple, but work extremely well


Sub move_rows()

Set MasterSheet = ActiveSheet
With MasterSheet
Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For movesheet = 3 To 1 Step -1
MoveRowCount = 1
Worksheets.Add after:=Worksheets(.Index)
'newworksheet is now actrive sheet
For RowCount = movesheet To Lastrow Step 3
.Rows(RowCount).Copy Destination:=ActiveSheet.Rows(MoveRowCount)
MoveRowCount = MoveRowCount + 1
Next RowCount
Next movesheet
End With
End Sub
"Beep Beep" wrote:

I have a worksheet that has over 1,000 rows with no labels. The first three
columns have the same labels. Here is what I would like to do:

I would like to create 3(three) worksheets by picking the following:

1St group (tab) would include rows 1, 4, 7, 10, 13 etc. adding the 3rd row
to the end.

2nd group (tab) would include rows 2, 5, 8, 11, 14, etc. adding the 3rd row
to the end

3rd group (tab) would include rows 3, 6, 9, 12, etc. adding the 3rd row to
the end.

Thanks Joel:

Worked like a charm

"Joel" wrote:

This code is very simple, but work extremely well


Sub move_rows()

Set MasterSheet = ActiveSheet
With MasterSheet
Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For movesheet = 3 To 1 Step -1
MoveRowCount = 1
Worksheets.Add after:=Worksheets(.Index)
'newworksheet is now actrive sheet
For RowCount = movesheet To Lastrow Step 3
.Rows(RowCount).Copy Destination:=ActiveSheet.Rows(MoveRowCount)
MoveRowCount = MoveRowCount + 1
Next RowCount
Next movesheet
End With
End Sub
"Beep Beep" wrote:

I have a worksheet that has over 1,000 rows with no labels. The first three
columns have the same labels. Here is what I would like to do:

I would like to create 3(three) worksheets by picking the following:

1St group (tab) would include rows 1, 4, 7, 10, 13 etc. adding the 3rd row
to the end.

2nd group (tab) would include rows 2, 5, 8, 11, 14, etc. adding the 3rd row
to the end

3rd group (tab) would include rows 3, 6, 9, 12, etc. adding the 3rd row to
the end.