Saving Sheets into Multiple Files

B

becaboo77

I have a file with about 25 tabs (sheets) in it, but I want to save each tab
as a separate file & name the file the tab name. Is there a way to do this
automatically, or will I have to manually move each sheet into a new file &
save it?
 
D

Dave Peterson

Option Explicit
Sub testme()
Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets
wks.Copy 'to a new workbook
With ActiveSheet
.Parent.SaveAs Filename:="C:\temp\" & .Name
.Parent.Close savechanges:=False
End With
Next wks
End Sub

Adjust the path to what you want.
 
J

Jim May

Sub SheetsToSepBooks()
Set shOrig = Sheets(1).name
For Each sh In ActriveWorkbook.Worksheets
sh.Copy
ActiveWorkbok.SaveAs FileName:= "C:\Samples\" & sh.name & ".xls"
ActiveWorkbook.Close
Next sh
shOrig.Activate
End Sub

HTH
 
Top