Creating Individual Excel Files from Sheets

[Guest]

Excel 2003. I have multiple tabs (sheets?) in my workbook. I would like to
create an individual file for each sheet. How may I do this? I need to do
this regularly, so an automated procedure (versus manually cutting and
pasting) would be greatly appreciated. Thanks.

 

[Ron de Bruin]

Hi

Try this one that save the files in "C:\" with the sheet name

Sub test()
Dim a As Integer
Dim wb As Workbook
Application.ScreenUpdating = False
For a = 1 To ThisWorkbook.Worksheets.Count
ThisWorkbook.Sheets(a).Copy
Set wb = ActiveWorkbook
wb.SaveAs "C:\" & wb.Sheets(1).Name & ".xls"
wb.Close False
Set wb = Nothing
Next a
Application.ScreenUpdating = True
End Sub

 

[Guest]

Dear Ron:

Beautiful! Just what I needed. Now another question:

I would love to produce a module that would bring up a dialog that would
allow the user to browse to a file of his choice, specify a destination of
his choice, and then run this code on the workbook so specified and save the
individual files in the location specified.

How could I creeate such a module such that it is independent of a
particular worksheet? (I placed your code in the worksheet I am currently
working on, but would like the code to be standalone for this more generic
application). Thanks for any suggestions, and God bless.

Chaplain Doug

 

[Ron de Bruin]

Hi Chaplain Doug

I will make a example for you today (1-2 hours)
First I take a cup of coffee with my wife and children.

 

[Ron de Bruin]

Hi Chaplain Doug

Try this

You can copy this macro and function in a module of your personal.xls.

******************************************************
If you want to use the macro in all your workbooks you can copy the macro in
your personal.xls.
This is a (normal) hidden workbook that is loaded automatically by Excel.
When you record a macro, you have the option of recording it to your
Personal Macro Workbook.
The file, Personal.xls, is stored in your \XLStart directory.

The easiest is to record a dummy macro and choose Personal Macro Workbook.
Excel create the file for you this way.
Then copy your macro in this file and delete the dummy macro.
******************************************************

It will open the sheet you select and create a folder in the same path and copy the sheets as files in it.

specify a destination

You can look at this, but I like it this way<g>
http://www.oaltd.co.uk/MVP/Default.htm
BrowseForFolder.zip v2.0


Sub Copy_All_Sheets_To_New_Workbook()
Dim FName As Variant
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim MyPath As String
Dim SaveDriveDir As String
Dim DateString As String
Dim FolderName As String

SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'Or use a path like this "C:\Data"
ChDrive MyPath
ChDir MyPath

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls")
If FName <> False Then
If bIsBookOpen(Dir(FName)) Then
MsgBox "The file is already open"
Else
Application.ScreenUpdating = False
DateString = Format(Now, "yy-mm-dd hh-mm-ss")
Set WbMain = Workbooks.Open(FName)
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"
WbMain.Close False
Application.ScreenUpdating = True
End If
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

 

[Guest]

Looking forward to the solution. Enjoy the coffee.