Alternate Row Select in Sheet 1 then Paste to Sheet 2

S

Steevo

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
 
M

Mike H

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
 
S

ShaneDevenshire

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
 
S

Steevo

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 said:
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 said:
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
 
S

sutha

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top