need macro to copy worksheets into individual workbooks

[neov]

Hi all. Thanks in advance.

Have a workbook with approximately 25 worksheets in it.

I want to copy/paste/value each worksheet and save it as it's own workbook.

My code doesn't work, it hangs up on ws.copy every single time, on Excel 2007 and prior versions.

Does anyone have working code for something like this?

FYI, my current code is : - I had posted in another thread, but the title was misleading!

Sub SaveWS()
Dim wb As Workbook
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
ws.Copy
Set wb = ActiveWorkbook
wb.SaveAs "t:\dir1\expenses\" & ws.Name & ".xls"
wb.Close False
Next ws

End Sub

 

[Norie]

Thomas

A solution to what?

Perhaps it would be better if you started a new thread.

 

[thomastapple]

I have a workbook with 255 individual spreadsheets that I would like to save with the same names as 255 separate files - one Excel workbook with one sheet for each of the 255 spreadsheets. None of the posted solutions work.

 

[ndendrinos]

http://www.mvps.org/dmcritchie/excel/saveas.htm

Tested this and it works for me. Further edit is required if you want the new WB to contain just the one sheet.

 

[thomastapple]

Yes, I need each sheet in a separate workbook. I have it just about complete except that I need to close and save the each workbook as they are created. Should not be too hard to complete that last step.

Thanks for your help.

 

[ndendrinos]

Not sure if you are talking to me Thomas .
In case you are using the code from the link I've posted the new WB should be created, saved and closed automatically ... no need for you to do it.
If you want to get rid of the extra sheets in each new WB add this to the code:

Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
      If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then
        Application.DisplayAlerts = False
        sh.Delete
        Application.DisplayAlerts = True
      End If
    Next

 

[ndendrinos]

That should do it Thomas (you will find the new WB in your "documents")
If you need a different path maybe you should start a new post.

Sub Macro1()
For Each sh In ThisWorkbook.Worksheets
   sh.Copy
   ActiveWorkbook.SaveAs Filename:=sh.Name, FileFormat:=xlNormal
   ActiveWindow.Close
Next sh

End Sub

 

[F&s anaylst]

hi Guys,

check out Mr Excel podcast episode 894 the code is already there just needs changed to suit xls or xlsx. file

 

[ravishankar]

HI thomas,
Not sure if you are still interested in splitting workbook. Here is a set of codes. Replace the file path to suit your case

Sub Macro3()
Dim d As String, b As String
Dim a As Integer
For a = 1 To Sheets.Count
b = Worksheets(a).Name
Sheets(a).Select
Sheets(a).Copy
d = "C:\Documents and Settings\HNravi.RAVI\Desktop\" & b & ".xls"
ActiveWorkbook.SaveAs d
ActiveWorkbook.Close
Next a
End Sub

On running the macro, it saves each sheet as a new workbook
Ravi