Macro Revision needed

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).Row + 1


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

Next



--
rand451
"HJ" <[email protected]> wrote in message
news:[email protected]...
>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:$117
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" <[email protected]> wrote in message
news:[email protected]...
> 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:$117
> 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" <[email protected]> wrote in message
> news:[email protected]...
> > 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
>
>
>