How to save each sheet as a separate excel-file

[Audio_freak]

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

 

[Tom Ogilvy]

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

 

[Ron de Bruin]

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

 

[Audio_freak]

Works !

Thanks!!

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

 

[Audio_freak]

En deze werkt ook ! Stukje korter zelfs.

Dank !!