Save Every Worksheet as its own Workbook

[Michael Smith]

Pretty straight forward I hope...need to save every worksheet in a
workbook as its own workbook (name of each file will obviously be same
as the name of each worksheet)

TIA


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Ron de Bruin]

Hi Michael

Try this
http://www.rondebruin.nl/copy6.htm

 

[Michael Smith]

Thanks Ron...So so close....but still not there yet. Your code
definetly helped but I didn't need the dating and folder creation part
of your code....am I close with this??
I am getting hungup on naming the file and continuing on to the other
sheets in my workbook.

Dim Wb As Workbook
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False

Set Wb = ThisWorkbook

For Each sh In Wb.Worksheets
Sheets(sh).Select
Sheets(sh).Copy
ChDir "C:\temp"
ActiveWorkbook.SaveAs Filename:="C:\temp\sh.xls"
Next sh

Application.ScreenUpdating = True
Application.EnableEvents = True


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Ron de Bruin]

No not close

sh is a reference to the sheet and you don't have to select it also
You can use sh.copy

Try this one

Sub Copy_All_Sheets_To_New_Workbook2()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False

Set WbMain = ThisWorkbook

For Each sh In WbMain.Worksheets
If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs "C:\Temp\" & Wb.Sheets(1).Name & ".xls"
Wb.Close False
End If
Next sh

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[Michael Smith]

The collection Sheets(1) won't work because my sheets have already been
named....Any way to just name the file the same as the current sheet
name? Thanks


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Ron de Bruin]

It is doing that

Have you try the macro ???

 

[Michael Smith]

yes I tried it... ..the code runs through to completion...but only
creates 1 file, named Sheet1 and no data is copied into the file.

Sub Copy_All_Sheets_To_New_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False

Set WbMain = ThisWorkbook

For Each sh In WbMain.Worksheets

Application.WindowState = xlMinimized

If sh.Visible = -1 Then
sh.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs "C:\Temp\" & Wb.Sheets(1).Name & ".xls"
Wb.Close False
End If
Next sh

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub






*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Ron de Bruin]

Did you copy the code in your personal.xls ?

 

[Michael Smith]

Yes


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Ron de Bruin]

Read the code good

Set WbMain = ThisWorkbook

Thisworkbook is the personal.xls file now because there is the code
Change it to

Set WbMain = Activeworkbook

 

[Michael Smith]

I hate obvious solutions...they make you feel extra dumb. All hail king
ron. Thank you, thank you, thank you.



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Ron de Bruin]

ron. Thank you, thank you, thank you

You are welcome