Hi:

I posted this last night but I think I was unclear as to what I need to do.
The code below (which was put together with the help of several forum
members) performs a check on 10 different worksheets to determine if anything
is in the first data entry cell of the last page. If not it goes to the next
page (up). When data is found it copies all cells on that page and above to a
primary spreadsheet. However, I am finding that I am spending a lot of time
adjusting row heights. Can anyone help me get this to copy the entire row,
rather than just the cells. I understand that would preserve the row heights
and solve my problem.
All sheets are same # columns and Rows.

It also goes back to sheets and clears entered data.


Sub Data_Ranges_Copy_and_Clear()

Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range

Dim iCounter As Integer
Dim iCounter2 As Integer


vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS Claim",
"Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold During")

'Select each sheet in turn

For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select

'Cells on this sheet to test
vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", "A129", "A99",
"A69", "A39", "A9")

'Corresponding ranges to copy
vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", "A1:P210",
"A1:P180", "A1:P150", "A1:P120", "A1:P90", "A1:P60", "A1:P30")

For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2))
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
'Now copy to other sheet
With Rng2
.Copy Rng3
' .ClearContents

End With

'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next

' Now Clear Data Ranges
Dim ws As Worksheet, i As Long

For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold
During"))

For i = 0 To 9
ws.Range("A1:L28").Offset(i * 30).ClearContents
Next i
Next
Sheets("INV").Select

End Sub


Thanks Very much,
--
Sam Fowler

hi sam:

too elaborate for me to comment on. i know this simple code works to copy
row1 from sheet 1 to the active row on sheet 2, but don't know how to apply
it in your case
i'm sure one of the experts will check in

Sub copy_row()
Worksheets("sheet1").Rows(1).Copy
Worksheets("sheet2").Paste
End Sub


--


Gary


"Sam Fowler" wrote in message
...
Hi:

I posted this last night but I think I was unclear as to what I need to
do.
The code below (which was put together with the help of several forum
members) performs a check on 10 different worksheets to determine if
anything
is in the first data entry cell of the last page. If not it goes to the
next
page (up). When data is found it copies all cells on that page and above
to a
primary spreadsheet. However, I am finding that I am spending a lot of
time
adjusting row heights. Can anyone help me get this to copy the entire row,
rather than just the cells. I understand that would preserve the row
heights
and solve my problem.
All sheets are same # columns and Rows.

It also goes back to sheets and clears entered data.


Sub Data_Ranges_Copy_and_Clear()

Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range

Dim iCounter As Integer
Dim iCounter2 As Integer


vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS
Claim",
"Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold During")

'Select each sheet in turn

For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select

'Cells on this sheet to test
vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", "A129",
"A99",
"A69", "A39", "A9")

'Corresponding ranges to copy
vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", "A1:P210",
"A1:P180", "A1:P150", "A1:P120", "A1:P90", "A1:P60", "A1:P30")

For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2))
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1,
0)
'Now copy to other sheet
With Rng2
.Copy Rng3
' .ClearContents

End With

'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next

' Now Clear Data Ranges
Dim ws As Worksheet, i As Long

For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold
During"))

For i = 0 To 9
ws.Range("A1:L28").Offset(i * 30).ClearContents
Next i
Next
Sheets("INV").Select

End Sub


Thanks Very much,
--
Sam Fowler

Sam,

Made some slight changes to the code.
At the code line with the <<<<, I have added ".EntireRow" which
should allow the copying of all rows in the copy range.
The changes, I made are untested.

Regards,
Jim Cone
San Francisco, USA

'-----------------------------------------------
Sub Data_Ranges_Copy_and_Clear()
Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range

Dim iCounter As Integer
Dim iCounter2 As Integer

vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", _
"OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
"Prepaid", "Sold During")
'Select each sheet in turn
For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select
'Cells on this sheet to test
vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", _
"A129", "A99", "A69", "A39", "A9")
'Corresponding ranges to copy
vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", _
"A1:P210", "A1:P180", "A1:P150", "A1:P120", _
"A1:P90", "A1:P60", "A1:P30")
For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2)).EntireRow '<<<<
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
'Now copy to other sheet
Rng2.Copy Rng3
'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next

'Now Clear Data Ranges
Dim ws As Worksheet, i As Long

For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", _
"Fact Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
"Prepaid", "Sold During "))
For i = 0 To 9
ws.Range("A1:L28").Offset(i * 30).ClearContents
Next i
Next
Sheets("INV").Select

Set rng = Nothing
Set Rng2 = Nothing
Set Rng3 = Nothing
End Sub
'----------------------------

"Sam Fowler"

wrote in message

Hi:
I posted this last night but I think I was unclear as to what I need to do.
The code below (which was put together with the help of several forum
members) performs a check on 10 different worksheets to determine if anything
is in the first data entry cell of the last page. If not it goes to the next
page (up). When data is found it copies all cells on that page and above to a
primary spreadsheet. However, I am finding that I am spending a lot of time
adjusting row heights. Can anyone help me get this to copy the entire row,
rather than just the cells. I understand that would preserve the row heights
and solve my problem.
All sheets are same # columns and Rows.

It also goes back to sheets and clears entered data.

- snip -

Thanks for the help on this

This did solve the row height problem. However I apparently have an
additional problem that I wasn't aware of.

The code is designed to check for data in the first entry cell on each page.
(Sheets are comprised of 30 Rows..First 8 are for Header, Description, etc.,
and the last 2 are for page totals and Grand Total. 9, 39, 69 etc.. are for
additional Pages. I need this to look at the checkpoints, with A279 being the
first entry cell on last Page. If Empty, go to page above and test, then
repeat up to a9 (First Page). It is doing that as best I can tell. However,
it is copying only those rows with data in column A. I need it to copy all 30
Rows of any Page that has data entered in the A9, A39, etc. Columns. Can you
give me any help on this?


Thanks very much,
Sam Fowler


"Jim Cone" wrote:

Sam,

Made some slight changes to the code.
At the code line with the <<<<, I have added ".EntireRow" which
should allow the copying of all rows in the copy range.
The changes, I made are untested.

Regards,
Jim Cone
San Francisco, USA

'-----------------------------------------------
Sub Data_Ranges_Copy_and_Clear()
Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range

Dim iCounter As Integer
Dim iCounter2 As Integer

vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", _
"OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
"Prepaid", "Sold During")
'Select each sheet in turn
For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select
'Cells on this sheet to test
vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", _
"A129", "A99", "A69", "A39", "A9")
'Corresponding ranges to copy
vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", _
"A1:P210", "A1:P180", "A1:P150", "A1:P120", _
"A1:P90", "A1:P60", "A1:P30")
For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2)).EntireRow '<<<<
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
'Now copy to other sheet
Rng2.Copy Rng3
'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next

'Now Clear Data Ranges
Dim ws As Worksheet, i As Long

For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", _
"Fact Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
"Prepaid", "Sold During "))
For i = 0 To 9
ws.Range("A1:L28").Offset(i * 30).ClearContents
Next i
Next
Sheets("INV").Select

Set rng = Nothing
Set Rng2 = Nothing
Set Rng3 = Nothing
End Sub
'----------------------------

"Sam Fowler"

wrote in message

Hi:
I posted this last night but I think I was unclear as to what I need to do.
The code below (which was put together with the help of several forum
members) performs a check on 10 different worksheets to determine if anything
is in the first data entry cell of the last page. If not it goes to the next
page (up). When data is found it copies all cells on that page and above to a
primary spreadsheet. However, I am finding that I am spending a lot of time
adjusting row heights. Can anyone help me get this to copy the entire row,
rather than just the cells. I understand that would preserve the row heights
and solve my problem.
All sheets are same # columns and Rows.

It also goes back to sheets and clears entered data.

- snip -

Sam,

"it is copying only those rows with data in column A"

The code works for me; the entire row is copied.
You could try putting a stop at the "next" line (just before it loops
to the next sheet). Then look at the INV sheet and see what was
pasted.

Regards,
Jim Cone


"Sam Fowler"

wrote in message
...
Thanks for the help on this

This did solve the row height problem. However I apparently have an
additional problem that I wasn't aware of.
The code is designed to check for data in the first entry cell on each page.
(Sheets are comprised of 30 Rows..First 8 are for Header, Description, etc.,
and the last 2 are for page totals and Grand Total. 9, 39, 69 etc.. are for
additional Pages. I need this to look at the checkpoints, with A279 being the
first entry cell on last Page. If Empty, go to page above and test, then
repeat up to a9 (First Page). It is doing that as best I can tell. However,
it is copying only those rows with data in column A. I need it to copy all 30
Rows of any Page that has data entered in the A9, A39, etc. Columns. Can you
give me any help on this?
Thanks very much,
Sam Fowler


"Jim Cone" wrote:
Sam,
Made some slight changes to the code.
At the code line with the <<<<, I have added ".EntireRow" which
should allow the copying of all rows in the copy range.
The changes, I made are untested.

Regards,
Jim Cone
San Francisco, USA

'-----------------------------------------------
Sub Data_Ranges_Copy_and_Clear()
Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range

Dim iCounter As Integer
Dim iCounter2 As Integer

vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", _
"OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
"Prepaid", "Sold During")
'Select each sheet in turn
For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select
'Cells on this sheet to test
vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", _
"A129", "A99", "A69", "A39", "A9")
'Corresponding ranges to copy
vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", _
"A1:P210", "A1:P180", "A1:P150", "A1:P120", _
"A1:P90", "A1:P60", "A1:P30")
For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2)).EntireRow '<<<<
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
'Now copy to other sheet
Rng2.Copy Rng3
'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next

'Now Clear Data Ranges
Dim ws As Worksheet, i As Long

For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", _
"Fact Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
"Prepaid", "Sold During "))
For i = 0 To 9
ws.Range("A1:L28").Offset(i * 30).ClearContents
Next i
Next
Sheets("INV").Select

Set rng = Nothing
Set Rng2 = Nothing
Set Rng3 = Nothing
End Sub
'----------------------------

"Sam Fowler"

wrote in message

Hi:
I posted this last night but I think I was unclear as to what I need to do.
The code below (which was put together with the help of several forum
members) performs a check on 10 different worksheets to determine if anything
is in the first data entry cell of the last page. If not it goes to the next
page (up). When data is found it copies all cells on that page and above to a
primary spreadsheet. However, I am finding that I am spending a lot of time
adjusting row heights. Can anyone help me get this to copy the entire row,
rather than just the cells. I understand that would preserve the row heights
and solve my problem.
All sheets are same # columns and Rows.
It also goes back to sheets and clears entered data.
- snip -

Jim:

You are correct. It does work. I realized I had no Data in some of the cells
in column A. By finding last cell and offsetting by one row, I was
overwriting some of the data already copied.

Thanks again
--
Sam Fowler


"Jim Cone" wrote:

Sam,

"it is copying only those rows with data in column A"

The code works for me; the entire row is copied.
You could try putting a stop at the "next" line (just before it loops
to the next sheet). Then look at the INV sheet and see what was
pasted.

Regards,
Jim Cone


"Sam Fowler"

wrote in message
...
Thanks for the help on this

This did solve the row height problem. However I apparently have an
additional problem that I wasn't aware of.
The code is designed to check for data in the first entry cell on each page.
(Sheets are comprised of 30 Rows..First 8 are for Header, Description, etc.,
and the last 2 are for page totals and Grand Total. 9, 39, 69 etc.. are for
additional Pages. I need this to look at the checkpoints, with A279 being the
first entry cell on last Page. If Empty, go to page above and test, then
repeat up to a9 (First Page). It is doing that as best I can tell. However,
it is copying only those rows with data in column A. I need it to copy all 30
Rows of any Page that has data entered in the A9, A39, etc. Columns. Can you
give me any help on this?
Thanks very much,
Sam Fowler


"Jim Cone" wrote:
Sam,
Made some slight changes to the code.
At the code line with the <<<<, I have added ".EntireRow" which
should allow the copying of all rows in the copy range.
The changes, I made are untested.

Regards,
Jim Cone
San Francisco, USA

'-----------------------------------------------
Sub Data_Ranges_Copy_and_Clear()
Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range

Dim iCounter As Integer
Dim iCounter2 As Integer

vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", _
"OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
"Prepaid", "Sold During")
'Select each sheet in turn
For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select
'Cells on this sheet to test
vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", _
"A129", "A99", "A69", "A39", "A9")
'Corresponding ranges to copy
vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", _
"A1:P210", "A1:P180", "A1:P150", "A1:P120", _
"A1:P90", "A1:P60", "A1:P30")
For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2)).EntireRow '<<<<
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
'Now copy to other sheet
Rng2.Copy Rng3
'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next

'Now Clear Data Ranges
Dim ws As Worksheet, i As Long

For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", _
"Fact Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
"Prepaid", "Sold During "))
For i = 0 To 9
ws.Range("A1:L28").Offset(i * 30).ClearContents
Next i
Next
Sheets("INV").Select

Set rng = Nothing
Set Rng2 = Nothing
Set Rng3 = Nothing
End Sub
'----------------------------

"Sam Fowler"

wrote in message

Hi:
I posted this last night but I think I was unclear as to what I need to do.
The code below (which was put together with the help of several forum
members) performs a check on 10 different worksheets to determine if anything
is in the first data entry cell of the last page. If not it goes to the next
page (up). When data is found it copies all cells on that page and above to a
primary spreadsheet. However, I am finding that I am spending a lot of time
adjusting row heights. Can anyone help me get this to copy the entire row,
rather than just the cells. I understand that would preserve the row heights
and solve my problem.
All sheets are same # columns and Rows.
It also goes back to sheets and clears entered data.
- snip -

..Copy Rng3.EntireRow


"Sam Fowler" wrote in message
...
Hi:

I posted this last night but I think I was unclear as to what I need to
do.
The code below (which was put together with the help of several forum
members) performs a check on 10 different worksheets to determine if
anything
is in the first data entry cell of the last page. If not it goes to the
next
page (up). When data is found it copies all cells on that page and above
to a
primary spreadsheet. However, I am finding that I am spending a lot of
time
adjusting row heights. Can anyone help me get this to copy the entire row,
rather than just the cells. I understand that would preserve the row
heights
and solve my problem.
All sheets are same # columns and Rows.

It also goes back to sheets and clears entered data.


Sub Data_Ranges_Copy_and_Clear()

Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range

Dim iCounter As Integer
Dim iCounter2 As Integer


vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS
Claim",
"Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold During")

'Select each sheet in turn

For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select

'Cells on this sheet to test
vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", "A129",
"A99",
"A69", "A39", "A9")

'Corresponding ranges to copy
vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", "A1:P210",
"A1:P180", "A1:P150", "A1:P120", "A1:P90", "A1:P60", "A1:P30")

For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2))
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1,
0)
'Now copy to other sheet
With Rng2
.Copy Rng3
' .ClearContents

End With

'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next

' Now Clear Data Ranges
Dim ws As Worksheet, i As Long

For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold
During"))

For i = 0 To 9
ws.Range("A1:L28").Offset(i * 30).ClearContents
Next i
Next
Sheets("INV").Select

End Sub


Thanks Very much,
--
Sam Fowler

William:

Thanks for the help on this.

I have posted a reply with an additional problem I am having with this code.
Any help you might be able to offer would be appreciated very much

Thanks
--
Sam Fowler


"William Benson" wrote:

..Copy Rng3.EntireRow


"Sam Fowler" wrote in message
...
Hi:

I posted this last night but I think I was unclear as to what I need to
do.
The code below (which was put together with the help of several forum
members) performs a check on 10 different worksheets to determine if
anything
is in the first data entry cell of the last page. If not it goes to the
next
page (up). When data is found it copies all cells on that page and above
to a
primary spreadsheet. However, I am finding that I am spending a lot of
time
adjusting row heights. Can anyone help me get this to copy the entire row,
rather than just the cells. I understand that would preserve the row
heights
and solve my problem.
All sheets are same # columns and Rows.

It also goes back to sheets and clears entered data.


Sub Data_Ranges_Copy_and_Clear()

Dim vCopySheets As Variant
Dim vCheckPoints As Variant
Dim vCopyRange As Variant
Dim rng As Range
Dim Rng2 As Range
Dim Rng3 As Range

Dim iCounter As Integer
Dim iCounter2 As Integer


vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS
Claim",
"Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold During")

'Select each sheet in turn

For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
Sheets(vCopySheets(iCounter)).Select

'Cells on this sheet to test
vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", "A129",
"A99",
"A69", "A39", "A9")

'Corresponding ranges to copy
vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", "A1:P210",
"A1:P180", "A1:P150", "A1:P120", "A1:P90", "A1:P60", "A1:P30")

For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
Set rng = Range(vCheckPoints(iCounter2))
If Not (IsEmpty(rng)) Then
'set copy area
Set Rng2 = Range(vCopyRange(iCounter2))
'Before copying find pasting point
Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1,
0)
'Now copy to other sheet
With Rng2
.Copy Rng3
' .ClearContents

End With

'Items found and copied so get out of (inner)loop
Exit For
End If
Next
'Move on to next sheet
Next

' Now Clear Data Ranges
Dim ws As Worksheet, i As Long

For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold
During"))

For i = 0 To 9
ws.Range("A1:L28").Offset(i * 30).ClearContents
Next i
Next
Sheets("INV").Select

End Sub


Thanks Very much,
--
Sam Fowler