5

Hi I am trying to use this code to save each sheet of Excel to a new workbook. However, it is saving the entire workbook to the new filename

Dim path As String
Dim dt As String
dt = Now()
path = CreateObject("WScript.Shell").specialfolders("Desktop") & "\Calendars " & Replace(Replace(dt, ":", "."), "/", ".")
MkDir path
Call Shell("explorer.exe" & " " & path, vbNormalFocus)

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'SetVersions
    If ws.name <> "How-To" And ws.name <> "Actg_Prd" Then
        ws.SaveAs path & ws.name, xlsx
    End If
Next ws

What is the quick fix?

4
  • create a new workbook and copy the sheet to it then save the new workbook.
    – Sorceri
    Commented Nov 12, 2013 at 21:39
  • 1
    Any easy way to implement Sorceri's suggestion is to use worksheet.Move........this will create the new workbook and allow to to later save and close it. Commented Nov 12, 2013 at 21:41
  • the only issue with move is that it's return value is void so you would have to find the workbook to save it.
    – Sorceri
    Commented Nov 12, 2013 at 21:51
  • You are correct!............... Commented Nov 12, 2013 at 22:01

2 Answers 2

13

Keeping the worksheet in the existing workbook and creating a new workbook with a copy

Dim path As String
Dim dt As String
dt = Now()
path = CreateObject("WScript.Shell").specialfolders("Desktop") & "\Calendars " & Replace(Replace(dt, ":", "."), "/", ".")
MkDir path
Call Shell("explorer.exe" & " " & path, vbNormalFocus)

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'SetVersions
    If ws.Name <> "How-To" And ws.Name <> "Actg_Prd" Then
        Dim wb As Workbook
        Set wb = ws.Application.Workbooks.Add
        ws.Copy Before:=wb.Sheets(1)
        wb.SaveAs path & ws.Name, Excel.XlFileFormat.xlOpenXMLWorkbook
        Set wb = Nothing
    End If
Next ws
2
  • 1
    That is very nice - thanks, and without having to use ActiveWorkbook
    – Kairan
    Commented Nov 12, 2013 at 22:02
  • @Sorceri Yeah I did that, that was the easy part
    – Kairan
    Commented Nov 13, 2013 at 0:02
2

I recommend introducing some error checking so as to ensure the folder you'll ultimately try to save workbooks to, actually exists. This will also create the folder relative to wherever you've saved your macro-enabled excel file.

On Error Resume Next
MkDir ThisWorkbook.path & "\Calendars\"
On Error GoTo 0

I also highly recommend closing the newly created workbook as soon as it's saved. If you are trying to create a large number of new workbooks, you'll quickly find how much it lags your system.

wb.Close

Moreover, Sorceri's code will not save an excel file with the appropriate file extension. You must specify that in the file name.

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'SetVersions
    If ws.Name <> "How-To" And ws.Name <> "Actg_Prd" Then
        Dim wb As Workbook
        Set wb = ws.Application.Workbooks.Add
        ws.Copy Before:=wb.Sheets(1)
        wb.SaveAs path & ws.Name & ".xlsx", Excel.XlFileFormat.xlOpenXMLWorkbook
        wb.Close
        Set wb = Nothing
    End If
Next ws

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.