I have the following macro which copies certain rows from a large spreadsheet
to a separate worksheet. This macro currently copies rows 19, 20 and 21. I
would like to add on to this macro to also copy rows 25, 26, 30, 32, 33, and
34 to that same worksheet.

Can someone help with the code to add this data? I would like to have all
the copied data on one tab (Data Master-Likely) and I'm not sure how to write
the code to look for the first empty row on the newly created master tab
(Data Master-Likely)and then loop through the process again. I hope that
makes sense.

Sub CopyLikelyDataData()
Dim i As Long, rng As Range, sh As Worksheet
Dim rng1 As Range
Worksheets.Add(After:=Worksheets( _
Worksheets.Count)).Name = "Data Master-Likely"
Set sh = Worksheets("Data Entry-Likely to Acquire")
i = 19
Do While Not IsEmpty(sh.Cells(i, 1))
Set rng = Union(sh.Cells(i, 1), _
sh.Cells(i + 1, 1).Resize(2, 1))
rng.EntireRow.Copy
Set rng1 = Worksheets("Data Master-Likely") _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng1.PasteSpecial xlValues
rng1.PasteSpecial xlFormats
i = i + 52
Loop
End Sub

Thanks in advance for your help.

HJ

I like to do this the long way, using R1C1 notation.
Try something like this (untested) (note that there is no
selection during code)

Dim rw As Integer, lrw As Integer, i As Integer

For i = 1 To 8
Select Case i ' define rows to be copied
Case 1
rw = 19
Case 2
rw = 20
Case 3
rw = 21
Case 4
rw = 25
Case 5
rw = 26
Case 6
rw = 30
Case 7
rw = 32
Case 8
rw = 33
End Select

' find 1st open row on new sheet
lrw = Sheets("NewData").Cells(Rows.Count, "A").End(xlUp).Offset(1,
0).Row

' alternate formula for 1st open row on new sheet
' lrw = Sheets("NewData").Cells.SpecialCells(xlLastCell).R ow + 1


' copy rows to new sheet
Sheets("MyData").Rows(rw).Copy _
Destination:=Sheets("NewData").Cells(lrw, 1)

Next



--
rand451
"HJ" wrote in message
...
I have the following macro which copies certain rows from a large
spreadsheet
to a separate worksheet. This macro currently copies rows 19, 20 and 21.
I
would like to add on to this macro to also copy rows 25, 26, 30, 32, 33,
and
34 to that same worksheet.

Can someone help with the code to add this data? I would like to have all
the copied data on one tab (Data Master-Likely) and I'm not sure how to
write
the code to look for the first empty row on the newly created master tab
(Data Master-Likely)and then loop through the process again. I hope that
makes sense.

Sub CopyLikelyDataData()
Dim i As Long, rng As Range, sh As Worksheet
Dim rng1 As Range
Worksheets.Add(After:=Worksheets( _
Worksheets.Count)).Name = "Data Master-Likely"
Set sh = Worksheets("Data Entry-Likely to Acquire")
i = 19
Do While Not IsEmpty(sh.Cells(i, 1))
Set rng = Union(sh.Cells(i, 1), _
sh.Cells(i + 1, 1).Resize(2, 1))
rng.EntireRow.Copy
Set rng1 = Worksheets("Data Master-Likely") _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng1.PasteSpecial xlValues
rng1.PasteSpecial xlFormats
i = i + 52
Loop
End Sub

Thanks in advance for your help.

HJ

If you'd like to be able to select which rows of data you want to copy onto
the new worksheet, try this code. It assumes you will select a cell in each
row to be copied. This will allow you to accommodate any future changes in
which rows to copy

Sub CopyData()
' Copies selected rows of data from one sheet to another.
'
' The target sheet (DataMaster) is created to receive the data,
' and increments 1 row for each cell selected on source sheet (DataEntry).
'
' Source sheet (DataEntry) values are the entire rows for each cell the user
selects.

Dim wks1 As Worksheet, wks2 As Worksheet
Dim lRow As Long, c As Object

Set wks1 = ActiveWorkbook.Sheets("DataEntry")
Set wks2 = Worksheets.Add(after:=Sheets(ActiveWorkbook.Sheets .Count))
wks2.Name = "DataMaster"
wks1.Activate
lRow = 1

' Ctrl+Select any cell of each 'row' to be copied
For Each c In Selection
c.EntireRow.Copy
With wks2.Rows(lRow)
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
lRow = lRow + 1
Next

Application.CutCopyMode = False
wks2.Activate

End Sub



"HJ" wrote:

I have the following macro which copies certain rows from a large spreadsheet
to a separate worksheet. This macro currently copies rows 19, 20 and 21. I
would like to add on to this macro to also copy rows 25, 26, 30, 32, 33, and
34 to that same worksheet.

Can someone help with the code to add this data? I would like to have all
the copied data on one tab (Data Master-Likely) and I'm not sure how to write
the code to look for the first empty row on the newly created master tab
(Data Master-Likely)and then loop through the process again. I hope that
makes sense.

Sub CopyLikelyDataData()
Dim i As Long, rng As Range, sh As Worksheet
Dim rng1 As Range
Worksheets.Add(After:=Worksheets( _
Worksheets.Count)).Name = "Data Master-Likely"
Set sh = Worksheets("Data Entry-Likely to Acquire")
i = 19
Do While Not IsEmpty(sh.Cells(i, 1))
Set rng = Union(sh.Cells(i, 1), _
sh.Cells(i + 1, 1).Resize(2, 1))
rng.EntireRow.Copy
Set rng1 = Worksheets("Data Master-Likely") _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng1.PasteSpecial xlValues
rng1.PasteSpecial xlFormats
i = i + 52
Loop
End Sub

Thanks in advance for your help.

HJ

Is it possible to add a loop so that once I select say row 19, 20, 21, 25,
26, 30, 32, 33, 34, 49, 50, and 65, the macro would look down 52 rows and
repeat the process (so that rows 71, 72, 73, etc.) are copied all the way
through the spreadsheet?

I've modified my original macro to accomplish this but I now have multiple
macros with multiple destination sheets which I need to consolidate. I'd
prefer to have one destination sheet. If I left my original macro as is, how
would I write a second macro to copy additional rows to the destination sheet
created in the original macro (so look for the first empty row and copy
there). Does that make sense?

Thanks again for your help.

"GS" wrote:

If you'd like to be able to select which rows of data you want to copy onto
the new worksheet, try this code. It assumes you will select a cell in each
row to be copied. This will allow you to accommodate any future changes in
which rows to copy

Sub CopyData()
' Copies selected rows of data from one sheet to another.
'
' The target sheet (DataMaster) is created to receive the data,
' and increments 1 row for each cell selected on source sheet (DataEntry).
'
' Source sheet (DataEntry) values are the entire rows for each cell the user
selects.

Dim wks1 As Worksheet, wks2 As Worksheet
Dim lRow As Long, c As Object

Set wks1 = ActiveWorkbook.Sheets("DataEntry")
Set wks2 = Worksheets.Add(after:=Sheets(ActiveWorkbook.Sheets .Count))
wks2.Name = "DataMaster"
wks1.Activate
lRow = 1

' Ctrl+Select any cell of each 'row' to be copied
For Each c In Selection
c.EntireRow.Copy
With wks2.Rows(lRow)
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
lRow = lRow + 1
Next

Application.CutCopyMode = False
wks2.Activate

End Sub



"HJ" wrote:

I have the following macro which copies certain rows from a large spreadsheet
to a separate worksheet. This macro currently copies rows 19, 20 and 21. I
would like to add on to this macro to also copy rows 25, 26, 30, 32, 33, and
34 to that same worksheet.

Can someone help with the code to add this data? I would like to have all
the copied data on one tab (Data Master-Likely) and I'm not sure how to write
the code to look for the first empty row on the newly created master tab
(Data Master-Likely)and then loop through the process again. I hope that
makes sense.

Sub CopyLikelyDataData()
Dim i As Long, rng As Range, sh As Worksheet
Dim rng1 As Range
Worksheets.Add(After:=Worksheets( _
Worksheets.Count)).Name = "Data Master-Likely"
Set sh = Worksheets("Data Entry-Likely to Acquire")
i = 19
Do While Not IsEmpty(sh.Cells(i, 1))
Set rng = Union(sh.Cells(i, 1), _
sh.Cells(i + 1, 1).Resize(2, 1))
rng.EntireRow.Copy
Set rng1 = Worksheets("Data Master-Likely") _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng1.PasteSpecial xlValues
rng1.PasteSpecial xlFormats
i = i + 52
Loop
End Sub

Thanks in advance for your help.

HJ

Here is a sample:

Sub AB()
sStr = "A19:A21,A25:A26,A30,A32:A34,A49:A50,A65"
For i = 1 To 105 Step 52
Set rng = Cells(i, 1).Range(sStr).EntireRow
Debug.Print i, rng.Address
Next

End Sub
produces:

1 $19:$21,$25:$26,$30:$30,$32:$34,$49:$50,$65:$65
53 $71:$73,$77:$78,$82:$82,$84:$86,$101:$102,$117:$11 7
105 $123:$125,$129:$130,$134:$134,$136:$138,$153:$154, $169:$169


if these are the rows you want to copy and you want to stop when the 19 th
cell is blank then you can use the code below. However, copying row 65 goes
beyond your 52 row pattern, so that seems wrong.

Sub AB()
Dim sStr as String, i as Long
Dim sh as Worksheet
Dim sh1 as Worksheet
set sh1 = Worksheets.Add(After:=Worksheets( _
Worksheets.Count))
sh1.Name = "Data Master-Likely"
Set sh = Worksheets("Data Entry-Likely to Acquire")
sStr = "A19:A21,A25:A26,A30,A32:A34,A49:A50,A65"
For i = 1 To 65536 Step 52
Set rng = sh.Cells(i, 1).Range(sStr).EntireRow
if isempty(sh.Cells(i,1).Range("A19")) then exit sub
rng.copy Destination:=sh1.Cells(rows.count,1).End(xlup)(2)
Next
End sub

--
Regards,
Tom Ogilvy

"HJ" wrote in message
...
Is it possible to add a loop so that once I select say row 19, 20, 21, 25,
26, 30, 32, 33, 34, 49, 50, and 65, the macro would look down 52 rows and
repeat the process (so that rows 71, 72, 73, etc.) are copied all the way
through the spreadsheet?

I've modified my original macro to accomplish this but I now have multiple
macros with multiple destination sheets which I need to consolidate. I'd
prefer to have one destination sheet. If I left my original macro as is,
how
would I write a second macro to copy additional rows to the destination
sheet
created in the original macro (so look for the first empty row and copy
there). Does that make sense?

Thanks again for your help.

"GS" wrote:

If you'd like to be able to select which rows of data you want to copy
onto
the new worksheet, try this code. It assumes you will select a cell in
each
row to be copied. This will allow you to accommodate any future changes
in
which rows to copy

Sub CopyData()
' Copies selected rows of data from one sheet to another.
'
' The target sheet (DataMaster) is created to receive the data,
' and increments 1 row for each cell selected on source sheet
(DataEntry).
'
' Source sheet (DataEntry) values are the entire rows for each cell the
user
selects.

Dim wks1 As Worksheet, wks2 As Worksheet
Dim lRow As Long, c As Object

Set wks1 = ActiveWorkbook.Sheets("DataEntry")
Set wks2 = Worksheets.Add(after:=Sheets(ActiveWorkbook.Sheets .Count))
wks2.Name = "DataMaster"
wks1.Activate
lRow = 1

' Ctrl+Select any cell of each 'row' to be copied
For Each c In Selection
c.EntireRow.Copy
With wks2.Rows(lRow)
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
lRow = lRow + 1
Next

Application.CutCopyMode = False
wks2.Activate

End Sub



"HJ" wrote:

I have the following macro which copies certain rows from a large
spreadsheet
to a separate worksheet. This macro currently copies rows 19, 20 and
21. I
would like to add on to this macro to also copy rows 25, 26, 30, 32,
33, and
34 to that same worksheet.

Can someone help with the code to add this data? I would like to have
all
the copied data on one tab (Data Master-Likely) and I'm not sure how
to write
the code to look for the first empty row on the newly created master
tab
(Data Master-Likely)and then loop through the process again. I hope
that
makes sense.

Sub CopyLikelyDataData()
Dim i As Long, rng As Range, sh As Worksheet
Dim rng1 As Range
Worksheets.Add(After:=Worksheets( _
Worksheets.Count)).Name = "Data Master-Likely"
Set sh = Worksheets("Data Entry-Likely to Acquire")
i = 19
Do While Not IsEmpty(sh.Cells(i, 1))
Set rng = Union(sh.Cells(i, 1), _
sh.Cells(i + 1, 1).Resize(2, 1))
rng.EntireRow.Copy
Set rng1 = Worksheets("Data Master-Likely") _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng1.PasteSpecial xlValues
rng1.PasteSpecial xlFormats
i = i + 52
Loop
End Sub

Thanks in advance for your help.

HJ

Thank you very much!!! Once again, you have saved me tons of time trying to
figure this one out. It works perfectly.

Have a nice weekend.

"Tom Ogilvy" wrote:

Here is a sample:

Sub AB()
sStr = "A19:A21,A25:A26,A30,A32:A34,A49:A50,A65"
For i = 1 To 105 Step 52
Set rng = Cells(i, 1).Range(sStr).EntireRow
Debug.Print i, rng.Address
Next

End Sub
produces:

1 $19:$21,$25:$26,$30:$30,$32:$34,$49:$50,$65:$65
53 $71:$73,$77:$78,$82:$82,$84:$86,$101:$102,$117:$11 7
105 $123:$125,$129:$130,$134:$134,$136:$138,$153:$154, $169:$169


if these are the rows you want to copy and you want to stop when the 19 th
cell is blank then you can use the code below. However, copying row 65 goes
beyond your 52 row pattern, so that seems wrong.

Sub AB()
Dim sStr as String, i as Long
Dim sh as Worksheet
Dim sh1 as Worksheet
set sh1 = Worksheets.Add(After:=Worksheets( _
Worksheets.Count))
sh1.Name = "Data Master-Likely"
Set sh = Worksheets("Data Entry-Likely to Acquire")
sStr = "A19:A21,A25:A26,A30,A32:A34,A49:A50,A65"
For i = 1 To 65536 Step 52
Set rng = sh.Cells(i, 1).Range(sStr).EntireRow
if isempty(sh.Cells(i,1).Range("A19")) then exit sub
rng.copy Destination:=sh1.Cells(rows.count,1).End(xlup)(2)
Next
End sub

--
Regards,
Tom Ogilvy

"HJ" wrote in message
...
Is it possible to add a loop so that once I select say row 19, 20, 21, 25,
26, 30, 32, 33, 34, 49, 50, and 65, the macro would look down 52 rows and
repeat the process (so that rows 71, 72, 73, etc.) are copied all the way
through the spreadsheet?

I've modified my original macro to accomplish this but I now have multiple
macros with multiple destination sheets which I need to consolidate. I'd
prefer to have one destination sheet. If I left my original macro as is,
how
would I write a second macro to copy additional rows to the destination
sheet
created in the original macro (so look for the first empty row and copy
there). Does that make sense?

Thanks again for your help.

"GS" wrote:

If you'd like to be able to select which rows of data you want to copy
onto
the new worksheet, try this code. It assumes you will select a cell in
each
row to be copied. This will allow you to accommodate any future changes
in
which rows to copy

Sub CopyData()
' Copies selected rows of data from one sheet to another.
'
' The target sheet (DataMaster) is created to receive the data,
' and increments 1 row for each cell selected on source sheet
(DataEntry).
'
' Source sheet (DataEntry) values are the entire rows for each cell the
user
selects.

Dim wks1 As Worksheet, wks2 As Worksheet
Dim lRow As Long, c As Object

Set wks1 = ActiveWorkbook.Sheets("DataEntry")
Set wks2 = Worksheets.Add(after:=Sheets(ActiveWorkbook.Sheets .Count))
wks2.Name = "DataMaster"
wks1.Activate
lRow = 1

' Ctrl+Select any cell of each 'row' to be copied
For Each c In Selection
c.EntireRow.Copy
With wks2.Rows(lRow)
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
lRow = lRow + 1
Next

Application.CutCopyMode = False
wks2.Activate

End Sub



"HJ" wrote:

I have the following macro which copies certain rows from a large
spreadsheet
to a separate worksheet. This macro currently copies rows 19, 20 and
21. I
would like to add on to this macro to also copy rows 25, 26, 30, 32,
33, and
34 to that same worksheet.

Can someone help with the code to add this data? I would like to have
all
the copied data on one tab (Data Master-Likely) and I'm not sure how
to write
the code to look for the first empty row on the newly created master
tab
(Data Master-Likely)and then loop through the process again. I hope
that
makes sense.

Sub CopyLikelyDataData()
Dim i As Long, rng As Range, sh As Worksheet
Dim rng1 As Range
Worksheets.Add(After:=Worksheets( _
Worksheets.Count)).Name = "Data Master-Likely"
Set sh = Worksheets("Data Entry-Likely to Acquire")
i = 19
Do While Not IsEmpty(sh.Cells(i, 1))
Set rng = Union(sh.Cells(i, 1), _
sh.Cells(i + 1, 1).Resize(2, 1))
rng.EntireRow.Copy
Set rng1 = Worksheets("Data Master-Likely") _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng1.PasteSpecial xlValues
rng1.PasteSpecial xlFormats
i = i + 52
Loop
End Sub

Thanks in advance for your help.

HJ