Alternate Row Select in Sheet 1 then Paste to Sheet 2
 

Trying to code an every other 10th row select from Sheet 1 (with 3000 rows of
data) and do this 128 times, Then paste the 128 row selection to Sheet 2.
Sample code below is proof of concept. Do I use while?, loop ?, until ? then
increment row to be selected by 10 (row=10, row=20, row=30 and so on until I
have a selection of 128 rows from Sheet 1?

'**Sample code**
Sub SeveralRows()
Worksheets("Sheet1").Activate
Dim myUnion As Range
Set myUnion = Union(Rows(1), Rows(10), Rows(20)) ' for 128 rows
myUnion.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
End Sub

###
Thanks,
Stephen

Alternate Row Select in Sheet 1 then Paste to Sheet 2
 

Steevo,

Right click sheet1 sheet tab, view code and paste this in and run it

Sub sonic()
Dim copyrange As Range
Set copyrange = Rows(1)
For x = 10 To 1270 Step 10
Set copyrange = Union(copyrange, Rows(x))
Next
copyrange.Copy
Sheets("Sheet2").Range("A1").PasteSpecial
Application.CutCopyMode = False
Sheets("Sheet2").Range("A1").Select
End Sub

Mike

"Steevo" wrote:

Trying to code an every other 10th row select from Sheet 1 (with 3000 rows of
data) and do this 128 times, Then paste the 128 row selection to Sheet 2.
Sample code below is proof of concept. Do I use while?, loop ?, until ? then
increment row to be selected by 10 (row=10, row=20, row=30 and so on until I
have a selection of 128 rows from Sheet 1?

'**Sample code**
Sub SeveralRows()
Worksheets("Sheet1").Activate
Dim myUnion As Range
Set myUnion = Union(Rows(1), Rows(10), Rows(20)) ' for 128 rows
myUnion.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
End Sub

###
Thanks,
Stephen

Alternate Row Select in Sheet 1 then Paste to Sheet 2
 

Hi,

Here is a different approach which run very fast.

Sub Every10th()
Application.ScreenUpdating = False
[A1].EntireColumn.Insert
[A1:A3000].Select
Selection = "=1/MOD(ROW(),10)"
Selection = Selection.Value
[A1].EntireRow.Insert
ActiveCell = "Title"
Selection.AutoFilter Field:=1, Criteria1:="#DIV/0!"
Selection.Offset(1, 1).Resize(, 20).Copy Sheets("Sheet2").Range("A1")
[A1].EntireColumn.Delete
[A1].EntireRow.Delete
End Sub

The Resize argument can be removed if you are only copying column A data.
If you have something common in column A on every 10th row you can shorten
this code to

Sub Every10th()
Application.ScreenUpdating = False
[A1:A3000].Select
Selection.AutoFilter Field:=1, Criteria1:="my common entry"
Selection.Offset(1, 0).Copy Sheets("Sheet2").Range("A1")
End Sub

--
Thanks,
Shane Devenshire


"Steevo" wrote:

Trying to code an every other 10th row select from Sheet 1 (with 3000 rows of
data) and do this 128 times, Then paste the 128 row selection to Sheet 2.
Sample code below is proof of concept. Do I use while?, loop ?, until ? then
increment row to be selected by 10 (row=10, row=20, row=30 and so on until I
have a selection of 128 rows from Sheet 1?

'**Sample code**
Sub SeveralRows()
Worksheets("Sheet1").Activate
Dim myUnion As Range
Set myUnion = Union(Rows(1), Rows(10), Rows(20)) ' for 128 rows
myUnion.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
End Sub

###
Thanks,
Stephen

Alternate Row Select in Sheet 1 then Paste to Sheet 2
 

THANKS Shane! You ain't kidding this runs very fast & and a perfect fit. I
was thinking that MOD() function having used with alternate row conditional
formatting, just didn't know what you just taught me. Thanks again!

Thanks,
Steevo

"ShaneDevenshire" wrote:

Hi,

Here is a different approach which run very fast.

Sub Every10th()
Application.ScreenUpdating = False
[A1].EntireColumn.Insert
[A1:A3000].Select
Selection = "=1/MOD(ROW(),10)"
Selection = Selection.Value
[A1].EntireRow.Insert
ActiveCell = "Title"
Selection.AutoFilter Field:=1, Criteria1:="#DIV/0!"
Selection.Offset(1, 1).Resize(, 20).Copy Sheets("Sheet2").Range("A1")
[A1].EntireColumn.Delete
[A1].EntireRow.Delete
End Sub

The Resize argument can be removed if you are only copying column A data.
If you have something common in column A on every 10th row you can shorten
this code to

Sub Every10th()
Application.ScreenUpdating = False
[A1:A3000].Select
Selection.AutoFilter Field:=1, Criteria1:="my common entry"
Selection.Offset(1, 0).Copy Sheets("Sheet2").Range("A1")
End Sub

--
Thanks,
Shane Devenshire


"Steevo" wrote:

Trying to code an every other 10th row select from Sheet 1 (with 3000 rows of
data) and do this 128 times, Then paste the 128 row selection to Sheet 2.
Sample code below is proof of concept. Do I use while?, loop ?, until ? then
increment row to be selected by 10 (row=10, row=20, row=30 and so on until I
have a selection of 128 rows from Sheet 1?

'**Sample code**
Sub SeveralRows()
Worksheets("Sheet1").Activate
Dim myUnion As Range
Set myUnion = Union(Rows(1), Rows(10), Rows(20)) ' for 128 rows
myUnion.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
End Sub

###
Thanks,
Stephen

Alternate Row Select in Sheet 1 then Paste to Sheet 2
 

HI Mike,
i like to use this macro to coppy every 10 raws in different sheets nad
name the sheets with the ist word at the begining of each range. Is it
possible. Your help is much appreciated.- Sutha

"Mike H" wrote:

Steevo,

Right click sheet1 sheet tab, view code and paste this in and run it

Sub sonic()
Dim copyrange As Range
Set copyrange = Rows(1)
For x = 10 To 1270 Step 10
Set copyrange = Union(copyrange, Rows(x))
Next
copyrange.Copy
Sheets("Sheet2").Range("A1").PasteSpecial
Application.CutCopyMode = False
Sheets("Sheet2").Range("A1").Select
End Sub

Mike

"Steevo" wrote:

Trying to code an every other 10th row select from Sheet 1 (with 3000 rows of
data) and do this 128 times, Then paste the 128 row selection to Sheet 2.
Sample code below is proof of concept. Do I use while?, loop ?, until ? then
increment row to be selected by 10 (row=10, row=20, row=30 and so on until I
have a selection of 128 rows from Sheet 1?

'**Sample code**
Sub SeveralRows()
Worksheets("Sheet1").Activate
Dim myUnion As Range
Set myUnion = Union(Rows(1), Rows(10), Rows(20)) ' for 128 rows
myUnion.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
End Sub

###
Thanks,
Stephen