Copy worksheets and save files dynamically
 

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

Copy worksheets and save files dynamically
 

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


--
Jacob


"BabyMc" wrote:

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

Copy worksheets and save files dynamically
 

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?


"Jacob Skaria" wrote:

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


--
Jacob


"BabyMc" wrote:

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

Copy worksheets and save files dynamically
 

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

"Jacob Skaria" wrote:

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


--
Jacob


"BabyMc" wrote:

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