Copy pages from one worksheet to another
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("a1:p150").Select Range("A99").Select If IsEmpty(ActiveCell) Then Range("A69").Select Else: Range("A1:P120").Select Range("A69").Select If IsEmpty(ActiveCell) Then Range("A39").Select Else: Range("A1:P90").Select Range("A39").Select If IsEmpty(ActiveCell) Then Range("A9").Select Else: Range("A1:P60").Select Range("A9").Select If Range("A9") < "" Then Range("A1:P30").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 |
Copy pages from one worksheet to another
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("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 Sheets("INV").Select End Sub Hope this helps Regards Paul "Sam Fowler" wrote in message ... 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("a1:p150").Select Range("A99").Select If IsEmpty(ActiveCell) Then Range("A69").Select Else: Range("A1:P120").Select Range("A69").Select If IsEmpty(ActiveCell) Then Range("A39").Select Else: Range("A1:P90").Select Range("A39").Select If IsEmpty(ActiveCell) Then Range("A9").Select Else: Range("A1:P60").Select Range("A9").Select If Range("A9") < "" Then Range("A1:P30").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 |
Copy pages from one worksheet to another
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 ("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 Sheets("INV").Select End Sub Hope this helps Regards Paul "Sam Fowler" wrote in message ... 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("a1:p150").Select Range("A99").Select If IsEmpty(ActiveCell) Then Range("A69").Select Else: Range("A1:P120").Select Range("A69").Select If IsEmpty(ActiveCell) Then Range("A39").Select Else: Range("A1:P90").Select Range("A39").Select If IsEmpty(ActiveCell) Then Range("A9").Select Else: Range("A1:P60").Select Range("A9").Select If Range("A9") < "" Then Range("A1:P30").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 . |
All times are GMT +1. The time now is 01:16 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com