Copy worksheets and save files dynamically




I've been trying to write a macro to copy each worksheet within a workbook
and then save each worksheet as it's own file. However I would like to do
this dynamically (ideally to keep the macro short and easier to follow) so
that the worksheet is selected based on a cell reference and the filename it
is saved as is also based on a cell reference.
I've searched the forum and tried to use some of the solutions, to similar
queries, from there - which led me to try and use called subroutines. This
seemed like a neater soloutin but I keep getting various error messages; and
I'm not familiar enough with macros to work out what the problems are.

I've copied the "long" macro that I've developed so far and tried to comment
on what I would like to do (I hope that isn't patronising).

Sub SB001000()
Application.DisplayAlerts = False
' This is the workbook containing the worksheets to be copied and saved
Workbooks.Open Filename:= _
"H:\Fin Management\Education, etc\Education 2009-10\School
Reports\Budget Reports\Current month\School Budget Reports 08-02-10.xls"

' Each worksheet has a similar name (e.g. Output (001000); Output (001001)
etc) Ideally dynamically obtain these names based on a range of cell
reference - e.g. cell A1 contains the name Output (001000); cell A2 = Output
(001001) etc
Sheets("Output 1 (001000)").Select
Sheets("Output 1 (001000)").Copy

' Each new workbook would be saved with a similar name (e.g. 001001 School
ActiveWorkbook.Saveas Filename:= _
"H:\Fin Management\Education, etc\Education 2009-10\School
Reports\Budget Reports\Current month\001000 School Budget.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Workbooks("001000 School Budget.xls").Close
' Once all worksheets have been copied and saved as a new workbook then
close the "master" workbook
Workbooks("School Budget Reports 08-02-10.xls").Close
Application.DisplayAlerts = True
End Sub

Thanks for any help



Jacob Skaria

Check out this macro

Sub SB001000()
Dim strPath As String, strFile As String
Dim wb As Workbook, ws As Worksheet, wbNew As Workbook

strPath = "H:\Fin Management\Education, etc\Education " & _
"2009-10\School Reports\Budget Reports\Current month\"
strFile = "School Budget Reports 08-02-10.xls"

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb = Workbooks.Open(strPath & strFile)
For Each ws In wb.Sheets
Set wbNew = ActiveWorkbook
wbNew.SaveAs strPath & Replace(Mid(ws.Name, _
InStr(ws.Name, "(") + 1), ")", "") & " School Budget.xls", xlNormal
wbNew.Close True

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



That may work - however it doesn't for me. I got a runtime error 13 message.

Looking into it, from the Microsoft Support site perhaps this is because I
am running XP SP2 (Excel 203). MS support says this is resolved in SP3.

Sorry I should have said this. Do you know if this is the problem and, if
so, of any other solution?




As well as my potential other problem (i.e. I may not be on the required
version of Excel) I've also noted something else. As mentioned I'm not that
familiar so apologies if I'm wrong here but...

Am I correct in thinking that this macro will save each file with an
incremental filename to the previous?
If so then apologies for giving a misleading example - but that won't work
exactly as the worksheets in the workbook aren't always consecutive in that
way; there are often large gaps in the numbering.
What I was hoping for was to take the number element of the worksheet name -
either from the tab name itself or from enetering the required filename in a
worksheet cell.

Thanks again

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question