PDA

View Full Version : Solved: Looping: Copy two worksheets to new workbook



goobers
08-06-2009, 11:58 AM
Good afternoon all. I had such a quick response a couple weeks ago that I thought I'd try to get some help again for my current issue.

I have a workbook with two worksheets that update every time a value in a given cell is changed. I have written a loop in VBA to change this value, but I am having a hard time figuring out how to copy and paste just the formats and values from these two worksheets into a new workbook. Another problem I am having is, for subsequent steps in the loop, the worksheets are being created into new workbooks, rather than the first new workbook that was created.

Below is the code I am currently using, where "gbprofitctr" is a named cell, and "P&L" and "Revenue" are the two worksheets that will need to be copied into a separate workbook (just the values and format).

Public Sub PrintUS()
Dim Orig As Integer
Dim US As Integer

Orig = Range("gbprofitctr").Value

For US = 2 To 7

Range("gbprofitctr").Value = US

Application.Calculate
Sheets(Array("P&L", "Revenue")).Select
Sheets(Array("P&L", "Revenue")).copy

Next US

Range("gbprofitctr").Value = Orig

End Sub

mdmackillop
08-06-2009, 02:33 PM
The code will change values 6 times and make 6 copies. Please add comments to your code indication what should happen. Which of the 6 value changes should be in the new book?

goobers
08-06-2009, 02:44 PM
I hope the comments I added are clear enough.

Every time the code loops, it should be updating the figures on the P&L and Revenue pages, which then need to be exported into the new workbook. So with the 6 loops, 12 new worksheets need to be copied into a single new workbook.

Public Sub PrintUS()
Dim Orig As Integer
Dim US As Integer

'Set Original Value
Orig = Range("gbprofitctr").Value

'Changes value in "gbprofitctr" from 2 through 7
For US = 2 To 7

Range("gbprofitctr").Value = US

'Calculates P&L and Revenue tabs based on new US Value
Application.Calculate

'Copy and paste value and formats of P&L and Revenue tabs into new workbook.
'At the next Loop, these worksheets should be added to the workbook that was just created for the first step of Loop.
Sheets(Array("P&L", "Revenue")).Select
Sheets(Array("P&L", "Revenue")).copy

Next US

'After reaching US=7, set value in "gbprofitctr" back to what it originally was.
Range("gbprofitctr").Value = Orig

End Sub

mdmackillop
08-06-2009, 02:47 PM
So do you want 6 books with 2 sheets or one book with 12 sheets. If the latter, how are the sheets named?

goobers
08-06-2009, 02:49 PM
So do you want 6 books with 2 sheets or one book with 12 sheets. If the latter, how are the sheets named?

One book with 12 sheets. I will most likely add the code from a previous post of mine to name the sheets accordingly.

mdmackillop
08-06-2009, 03:32 PM
Insert your own sheet names etc.


Option Explicit
Sub Macro1()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim i As Long

Application.ScreenUpdating = False

i = 2
Set WB1 = ActiveWorkbook
WB1.Sheets(1).Cells(3, 2) = i
Sheets(Array("Sheet1", "Sheet2")).Copy
Set WB2 = ActiveWorkbook

For i = 3 To 7
WB1.Sheets(1).Cells(3, 2) = i
WB1.Sheets(Array("Sheet1", "Sheet2")).Copy after:=WB2.Sheets(Sheets.Count)
Next

With WB2
For i = 1 To .Sheets.Count
.Sheets(i).Cells.Copy
.Sheets(i).Range("A1").PasteSpecial xlValues
Application.Goto .Sheets(i).Range("A1")
Next
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

goobers
08-07-2009, 09:46 AM
mdmackillop: Thank you so much for you help. The reply you provided got me exactly what i wanted and I will be able to use it for 2 out of 3 of my files.

However, my third file contains significantly more data and information, so I am receiving "Excel cannot complete this task with available resources" error.

I created a new post here (http://www.vbaexpress.com/forum/showthread.php?p=192089#post192089) that addresses the new question I have for that file.

mdmackillop
08-07-2009, 10:28 AM
Try copying one column at a time (untested)

Dim Col As Range
With WB2
For i = 1 To .Sheets.Count
For Each Col In Sheets(i).UsedRange.Columns
Col.Copy
Col(Cells(1)).PasteSpecial xlValues
Next
Application.Goto .Sheets(i).Range("A1")
Next
End With

goobers
08-07-2009, 11:12 AM
Try copying one column at a time (untested)

Dim Col As Range
With WB2
For i = 1 To .Sheets.Count
For Each Col In Sheets(i).UsedRange.Columns
Col.Copy
Col(Cells(1)).PasteSpecial xlValues
Next
Application.Goto .Sheets(i).Range("A1")
Next
End With



Still receiving the same Excel error. Thanks for the suggestion!

mdmackillop
08-07-2009, 04:39 PM
What works "manually"?