Copying multiple worksheets to another workbook

[Chris Maddogz]

I currently have a workbook (call it no name) & via a macro am copying some
worksheets from another workbook to it.

Is there an easy way to copy multiple worksheets from another workbook to
this noname workbook?

 

[Jacob Skaria]

Dear Chris

The below will copy Sheet1, Sheet2 and Sheet3 from open workbook Book1 to
another open workbook Book2 . These 3 sheets will be copied after the first
sheet in Book2. Will that help...

Workbooks("Book1").Worksheets(Array("Sheet1", _
"Sheet2")).Copy After:=Workbooks("Book2").Worksheets(1)

If this post helps click Yes

 

[Jacob Skaria]

Using an array variable...

Dim varSheets As Variant
varSheets = Array("Sheet1", "Sheet2", "Sheet3")

Workbooks("Book1").Worksheets(varSheets).Copy _
After:=Workbooks("Book2").Worksheets(1)

If this post helps click Yes

 

[Chris Maddogz]

Thanks again Jacob this question relates to other queries to which you have
already replied.
Basically I have a workbook called Jobs Workbook with the following
worksheets:
Invoice (this sheet has the macro buttons on it)
Sub Con C
Inv C
Sub C
Safety C
WorkMethod C
then some other worksheets
and I need to copy all the named sheets (taking only the data from Invoice -
leave off the macro buttons) to a new workbook (renaming Invoice to Cell E11)
and save the new workbook as per your solution from the item "Give a sheet a
name from data in a cell-saving to a specific folder" etc to which you
answered so well.

I tried manually recording the macro for the copying phase and blending in
your renaming and folder copy macro but had to make sure that I had
prevoiusly closed and reopened Excel before executing the macro otherwise it
had trouble with which Book"n" it was looking for (I was using the File ,New,
Workbook clicks before going through the individual worksheet copy process) a
bit longwinded but it was going okay until I opened another workbook for
another job.

I must say you have helped tremendously so far & I am nearly there if you
can help with this

 

[Chris Maddogz]

Finally got it all running but I have to close down Excel after entering a
job (a real problem)in " otherwise the Macro has trouble finding "Book1" on
subsequent jobs.
NB the first worksheet is called CONCRETE not INVOICE and the cell
reference for the worksheet/workbook rename is E1 not E11(my errors)

Here is my final code: (I recorded all the copying manually in order to
debug it clearer)

Hope you can help:

Sub savejobC()
' Macro recorded 23/05/2009 by Chris
'

'
Dim strName As String
Dim strPath As String
Dim strFolder As String
Sheets("CONCRETE").Select
Columns("A:E").Select
Selection.Copy
Workbooks.Add
Columns("A:A").Select
ActiveSheet.Paste
Windows("Jobs Workbook.xls").Activate
Sheets("SubCon C").Select
Application.CutCopyMode = False
Sheets("SubCon C").Copy After:=Workbooks("Book1").Sheets(1)
Windows("Jobs Workbook.xls").Activate
Sheets("Inv C").Select
Sheets("Inv C").Copy After:=Workbooks("Book1").Sheets(2)
Windows("Jobs Workbook.xls").Activate
Sheets("Sub C").Select
Sheets("Sub C").Copy After:=Workbooks("Book1").Sheets(3)
Windows("Jobs Workbook.xls").Activate
Sheets("Safety C").Select
Sheets("Safety C").Copy After:=Workbooks("Book1").Sheets(4)
Windows("Jobs Workbook.xls").Activate
Sheets("Work Method C").Select
Sheets("Work Method C").Copy After:=Workbooks("Book1").Sheets(5)
Windows("Jobs Workbook.xls").Activate
Sheets("CONCRETE").Select
Range("E1").Select
Windows("Book1").Activate
Sheets("Sheet1").Select
Range("E1").Select
strName = Left(Trim(Range("E1")), 3)
strPath = "c:\Jobs\"
If Dir(strPath & strName, vbDirectory) = "" Then
MkDir "c:\jobs\" & strName
End If
ActiveSheet.Name = Trim(Range("E1"))
ActiveWorkbook.SaveAs "c:\jobs\" & strName & "\" & Trim(Range("E1")) & ".xls"
End Sub

 

[Jacob Skaria]

Hi Chris...

Try the below and feedback....

Sub savejobC()
' Macro recorded 23/05/2009 by Chris
'

Dim strName As String
Dim strPath As String
Dim strFolder As String
Dim wbTemp As Workbook
Dim varSheets As Variant

varSheets = Array("SubCon C", "Inv C", "Sub C", "Safety C", "Work Method C")
Sheets("CONCRETE").Select
Columns("A:E").Copy
Set wbTemp = Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks("Jobs Workbook.xls").Sheets(varSheets).Copy _
After:=wbTemp.Worksheets(1)
wbTemp.Activate
Sheets("Sheet1").Select
strName = Left(Trim(Range("E1")), 3)
strPath = "c:\Jobs\"
If Dir(strPath & strName, vbDirectory) = "" Then
MkDir "c:\jobs\" & strName
End If
ActiveSheet.Name = Trim(Range("E1"))
ActiveWorkbook.SaveAs "c:\jobs\" & strName & "\" & Trim(Range("E1")) & ".xls"
End Sub

 

[Chris Maddogz]

Jacob that worked fantastically well but now I have had to add another set of
identical worksheets triggered by one called TERRACOTTA not CONCRETE so now
the "Jobs Workbook" has the following worksheets in this order:
INVOICE
TERRACOTTA
SubCon C
Inv C
Sub C
Safety C
Work Method C
SubCon T
Inv T
Sub T
Safety T
Work Method T

I copied your macro for savejobC & renamed it savejobT
changed the Sheets to TERRACOTTA
changed the varSheets values to reflect the "T" worksheets.
However when I run it I get a subscript out of range on the lines

Workbooks("Jobs Workbook.xls").Sheets(varSheets).Copy _
After:=wbTemp.Worksheets(1)

Following is the complete code for the copied macro

Thanks
Chris


Sub savejobT()
'
' savejobT Macro
' Macro recorded 24/05/2009 by Chris
'
'
Dim strName As String
Dim strPath As String
Dim strFolder As String
Dim wbTemp As Workbook
Dim varSheets As Variant

varSheets = Array("SubCon T", "Inv T", "Sub T", "Safety T", "Work Method T")
Sheets("TERRACOTTA").Select
Columns("A:E").Copy
Set wbTemp = Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks("Jobs Workbook.xls").Sheets(varSheets).Copy _
After:=wbTemp.Worksheets(1)
wbTemp.Activate
Sheets("Sheet1").Select
strName = Left(Trim(Range("E1")), 3)
strPath = "c:\Jobs\"
If Dir(strPath & strName, vbDirectory) = "" Then
MkDir "c:\jobs\" & strName
End If
ActiveSheet.Name = Trim(Range("E1"))
ActiveWorkbook.SaveAs "c:\jobs\" & strName & "\" & Trim(Range("E1")) & ".xls"
End Sub

 

[Jacob Skaria]

Chris, check for any spaces in your sheet tabs (before or after sheet names).

If this post helps click Yes

 

[Chris Maddogz]

I knew it had to be something simple like that - the Safety T spreadsheet
name did have a space after it - got rid of it & everything ran like a dream
Once again thank you for all your help with this - it saves an untold amount
of time in our processing of the jobs
Chris

 

[Chris Maddogz]

Jacob - a small problem has arisen as a result of this macro in that because
the sheets after CONCRETE & TERRACOTTA have imbedded links back to them I
need to remove them from the resultant saved spreadsheet within the 3 digit
generated folder otherwise when I try to open the saved job in it it asks
about updating the links back to the file Jobs Workbook.
This only showed up when I didn't have Jobs Workbook open at the same time
as I tried to open one of the saved jobs

 

[Chris Maddogz]

Sorry Jacob but of course I do need to retain the values in the cells where
there are links

 

[Chris Maddogz]

Its okay Jacob I've sorted it out now
Thanks

Chris, check for any spaces in your sheet tabs (before or after sheet names).

If this post helps click Yes