How do I save sheets in a workbook to separate files?

[Guest]

I have a wokbook with MANY sheets. I was wondering if there was a quick way
to save the sheets into separate files (perhaps using tab names) whilst
retaining each ones header and footer.

 

[Ron de Bruin]

Try this example Omzala
Copy this macro in a normal module

Sub Copy_All_Sheets_To_New_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String

Application.ScreenUpdating = False
DateString = Format(Now, "yy-mm-dd hh-mm-ss")
Set WbMain = ThisWorkbook
MkDir WbMain.Path & "\" & WbMain.Name & " " & DateString
FolderName = WbMain.Path & "\" & WbMain.Name & " " & DateString

For Each sh In WbMain.Worksheets
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs FolderName _
& "\" & Wb.Sheets(1).Name & ".xls"
Wb.Close False
Set Wb = Nothing
End If
Next sh
MsgBox "Look in " & FolderName & " for the files"
Application.ScreenUpdating = True
End Sub

 

[Gord Dibben]

Omzala

Sub Make_New_Books()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In ActiveWorkbook.Worksheets
w.Copy
ActiveWorkbook.SaveAs FileName:=ThisWorkbook.Path & "\" & w.Name
ActiveWorkbook.Close
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Gord Dibben Excel MVP