Copy worksheets and save files dynamically

[BabyMc]

Hello

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
Budget)
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
ws.Copy
Set wbNew = ActiveWorkbook
wbNew.SaveAs strPath & Replace(Mid(ws.Name, _
InStr(ws.Name, "(") + 1), ")", "") & " School Budget.xls", xlNormal
wbNew.Close True
Next
wb.Close

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

 

[BabyMc]

Jacob

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?

 

[BabyMc]

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