Hi, Happy New Year

Could anybody assist me with the code for saving each sheet to a separate
(newly created) file?

So that if I have an excel-file with 20 sheets, I would like a macro to
create 20 separate files.

The new files could get the same names as the sheets (preferably) or the
names could be taken from a cell in the relevant sheet.

Thanks for any help you can give.

Peter

Assumes the workbook with the 20 sheets has been saved and is not in the
Root directory.

Sub MakeWorkbooks()
Dim sh as worksheet
Dim sStr as String
for each sh in thisworkbook.Worksheets
sh.copy
sStr = ThisWorkbook.Path & "\" & sh.name & ".xls"
On Error Resume Next
Kill sStr
On Error goto 0
ActiveWorkbook.SaveAs sStr, xlWorkbookNormal
ActiveWorkbook.Close Savechanges:=False
Next
End Sub

--
Regards,
Tom Ogilvy


Audio_freak wrote in message
. 2.2...

Hi, Happy New Year

Could anybody assist me with the code for saving each sheet to a separate
(newly created) file?

So that if I have an excel-file with 20 sheets, I would like a macro to
create 20 separate files.

The new files could get the same names as the sheets (preferably) or the
names could be taken from a cell in the relevant sheet.

Thanks for any help you can give.

Peter

Try this Audio_freak

Sub test()
Application.ScreenUpdating = False
For a = 1 To Worksheets.Count
Sheets(a).Copy
ActiveWorkbook.SaveAs Sheets(1).Name
ActiveWorkbook.Close
Next a
Application.ScreenUpdating = True
End Sub


--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Audio_freak" wrote in message . 2.2...

Hi, Happy New Year

Could anybody assist me with the code for saving each sheet to a separate
(newly created) file?

So that if I have an excel-file with 20 sheets, I would like a macro to
create 20 separate files.

The new files could get the same names as the sheets (preferably) or the
names could be taken from a cell in the relevant sheet.

Thanks for any help you can give.

Peter

Works !

Thanks!!






"Tom Ogilvy" wrote in
:

Assumes the workbook with the 20 sheets has been saved and is not in
the Root directory.

Sub MakeWorkbooks()
Dim sh as worksheet
Dim sStr as String
for each sh in thisworkbook.Worksheets
sh.copy
sStr = ThisWorkbook.Path & "\" & sh.name & ".xls"
On Error Resume Next
Kill sStr
On Error goto 0
ActiveWorkbook.SaveAs sStr, xlWorkbookNormal
ActiveWorkbook.Close Savechanges:=False
Next
End Sub

--
Regards,
Tom Ogilvy


Audio_freak wrote in message
. 2.2...

Hi, Happy New Year

Could anybody assist me with the code for saving each sheet to a
separate (newly created) file?

So that if I have an excel-file with 20 sheets, I would like a macro
to create 20 separate files.

The new files could get the same names as the sheets (preferably) or
the names could be taken from a cell in the relevant sheet.

Thanks for any help you can give.

Peter

En deze werkt ook ! Stukje korter zelfs.

Dank !!





"Ron de Bruin" wrote in news:#hFAyuv0DHA.2856
@TK2MSFTNGP09.phx.gbl:

Try this Audio_freak

Sub test()
Application.ScreenUpdating = False
For a = 1 To Worksheets.Count
Sheets(a).Copy
ActiveWorkbook.SaveAs Sheets(1).Name
ActiveWorkbook.Close
Next a
Application.ScreenUpdating = True
End Sub