Copy pages from one worksheet to another

[Sam Fowler]

Hi :

Can anyone help me with this. I am trying to get a macro
to look at a worksheet and determine which of the 10
pages in the worksheet have data. (All pages are sized
exactly the same and contain data in the same cells (If
Data is present, it will first reside in a9 - Page1, A39 -
Page2, etc...)I would then like to copy the page(S) that
do contain data to the next empty cell in a different
worksheet. (formatting as well). Then go back to the
worksheet that was copied and clear the data. After that
I want it to go to the next worksheet and perform the
same processes.

The code below is where I am and being somewhat of a
novice, with VBA, I have used the macro recorder for most
of the code.

Sub CopyDOCS1()


Sheets("Used Cores").Select
Range("A129").Select
If IsEmpty(ActiveCell) Then
Range("A99").Select
Else: Range("a1150").Select

Range("A99").Select
If IsEmpty(ActiveCell) Then
Range("A69").Select
Else: Range("A1120").Select

Range("A69").Select
If IsEmpty(ActiveCell) Then
Range("A39").Select
Else: Range("A190").Select

Range("A39").Select
If IsEmpty(ActiveCell) Then
Range("A9").Select
Else: Range("A160").Select

Range("A9").Select
If Range("A9") <> "" Then
Range("A130").Select
Else: Exit Sub

End If
End If
End If
End If
End If

Selection.Copy

Sheets("INV").Select
Dim cell As Range
Set cell = Cells(65536, 1).End(xlUp)
Set cell = cell.Offset(1, 0).Select

ActiveSheet.Paste
Application.CutCopyMode = False

Sheets("Used Cores").Select
Range("A9:L28").Select
Selection.ClearContents


End Sub

Any help would be appreciated

Sam

 

[Paulw2k]

Hi Sam

With tasks like this, recording what you do will only take you so far.

One way of tackling this would be to use a couple of looping mechanisms,
e.g. For-loops.
1. To go through each sheet in turn
2. To test each point on the selected page. If something is there, copy
over to appropriate place and clear copied range.

So, here is one way. I am a little unclear how many sheets you have to look
through in your workbook but here I have used three.
Also as I understand your query, you test each cell A129, A99,..., in turn;
find the first one with data and copy across the appropriate range, then
clear its contents.

Sub CopyDOCS()
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("Used Cores", "Used Cores 2", "Used Cores 3")
'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("A129", "A99", "A69", "A39", "A9")
'Corresponding ranges to copy
vCopyRange = Array("A1150", "A1120", "A190", "A160",
"A130")
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

Sheets("INV").Select

End Sub

Hope this helps


Regards

Paul

 

[Sam Fowler]

Hi Paul:

Thanks a lot for the code. I probably won't get a chance
now to actually use it til next week, but I have no doubt
it will work great for what I am trying to do.

If I can Find this message by then, I'll post to let you
know.

Thanks Again,

Sam

-----Original Message-----
Hi Sam

With tasks like this, recording what you do will only take you so far.

One way of tackling this would be to use a couple of looping mechanisms,
e.g. For-loops.
1. To go through each sheet in turn
2. To test each point on the selected page. If something is there, copy
over to appropriate place and clear copied range.

So, here is one way. I am a little unclear how many sheets you have to look
through in your workbook but here I have used three.
Also as I understand your query, you test each cell A129, A99,..., in turn;
find the first one with data and copy across the appropriate range, then
clear its contents.

Sub CopyDOCS()
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("Used Cores", "Used Cores 2", "Used Cores 3")
'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

("A129", "A99", "A69", "A39", "A9")

'Corresponding ranges to copy
vCopyRange = Array

("A1150", "A1120", "A190", "A160",