Macro Revision needed
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
|