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.
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.
Here's a macro that will create a new Excel workbook file for every worksheet in the active workbook (replace code in BOLD below with your own reference):
Sub createFilesFromSheets()
' Declare variables
Dim ws As Worksheet, mySheet, myPath
' *** Change file path reference below to your own...
myPath = "C:\TEMP"
' Loop through the worksheets in the workbook & create new file for each sheet
For Each ws In ActiveWorkbook.Worksheets
mySheet = ws.Name
ws.Copy Before:=Worksheets(1)
Worksheets(1).Move ' Move modified worksheet to a new file...
ActiveSheet.Name = mySheet
' Save the new file and close original without saving changes
' Set the file directory to search for previous version...
ChDir myPath
' Delete previous version of the file (if it exists)...
On Error Resume Next
Kill myPath & "\" & mySheet & ".xls"
' Save as Excel file w/Sheet name
ActiveWorkbook.SaveAs fileName:=myPath & "\" & mySheet & ".xls", FileFormat:= _
xlWorkbookNormal, CreateBackup:=False
' Close the new file...
ActiveWindow.Close SaveChanges:=False
Next ws
End Sub
Hope this helps,
theDude
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
--
Regards Ron de Bruin
http://www.rondebruin.nl
"Omzala" <[email protected]> wrote in message news:[email protected]...
>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.
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
On Thu, 13 Jan 2005 07:21:04 -0800, Omzala <[email protected]>
wrote:
>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.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks