0

How do I save a specific sheet to a new workbook using Excel VBA?

I have multiple sheets with names "Sheet1", "Sheet2", "Sheet3" and so on.

I'd like to save all, in individual workbooks, with a single click.

This is returns an alert

Method Save as of object workbook failed

Sub SaveSplitSheet()
    Dim ws As Worksheet
    Dim wb As Workbook
    
    For Each ws In ThisWorkbook.Sheets
        If ws.Name Like "Sheet" & "*" Then
            Application.DisplayAlerts = False
            ws.Copy
            ActiveWorkbook.SaveAs "/Users/Tukiyem/Downloads", FileFormat:=56
            ActiveWorkbook.Close SaveChanges:=True
  
            Application.DisplayAlerts = True
        End If
    Next
End Sub 

Found the answer-> the code below saves multiple sheets that contain name "sheet...." as individual workbooks.

Sub SaveAsInLoop()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Sheets
        If ws.Name Like "Sheet" & "*" Then
            Application.DisplayAlerts = False
            ws.Copy
            ActiveWorkbook.SaveAs "/Users/Tukiyem/Downloads/" & ws.Name & ".xlsx", FileFormat:=51
            ActiveWorkbook.Close SaveChanges:=True
            Application.DisplayAlerts = True
        End If
    Next
End Sub
Community
  • 1
  • 1
  • Is this with Excel workbooks or Google Sheets? – Samuel Everson May 02 '20 at 08:27
  • Also where do you want to put your copied worksheet? Currently, your code finds it, copies it and closes the workbook. – Samuel Everson May 02 '20 at 08:30
  • Hi Samuel, its excel. i want to put in this location /Users/Tukiyem/Downloads . the code above still return error. – user3357429 May 02 '20 at 08:40
  • What my last comment means is, you are copying the `Worksheet` but then closing and saving the `Workbook` (which is what your worksheets are in). Generally if you are copying a `Worksheet` you would want to put it in a new `Worksheet` in the same `Workbook` OR even in a whole new `Workbook`. If you simply want to save the workbook in a new location, you can just use the line `ActiveWorkbook.SaveAs "/Users/Tukiyem/Downloads", FileFormat:=56` Though you are always better to use a full file path and include a `/` at the end. – Samuel Everson May 02 '20 at 08:44
  • Does this answer your question? [How to copy only a single worksheet to another workbook using vba](https://stackoverflow.com/questions/20246465/how-to-copy-only-a-single-worksheet-to-another-workbook-using-vba) – Samuel Everson May 02 '20 at 08:46
  • Hi Samuel, yes, thanks that solved. error 1004 does not show again. But it only execute one sheet. I have multiple sheet to save. which has name "Sheets1, Sheets2, ...." – user3357429 May 02 '20 at 09:36
  • Don't close the workbook after `SaveAs` so the loop will continue to execute correctly (in it's current form you access the first worksheet and then close the workbook which will cause an error) – Samuel Everson May 02 '20 at 09:41

1 Answers1

0

I would slightly tweak your code to a For...Next loop rather For Each...Next which will allow the evaluation of which number sheet we are up to in the loop.

This code is an example of how to loop through the worksheets. It will print each sheet name to the Immediate window of the VBE.

Just adapt your SaveAs code within the loop.

Sub SaveAsInLoop()
Dim SheetNumber As Long

For SheetNumber = 1 To ThisWorkbook.Sheets.Count
    Debug.Print Sheets("Sheet" & SheetNumber).Name
Next SheetNumber

End Sub
Samuel Everson
  • 2,097
  • 2
  • 9
  • 24
  • Sub SaveAsInLoop() Dim ws As Worksheet For Each ws In ThisWorkbook.Sheets If ws.Name Like "Sheet" & "*" Then Application.DisplayAlerts = False ws.Copy ActiveWorkbook.SaveAs "/Users/tukiyem/Downloads/" & ws.Name & ".xlsx", FileFormat:=51 ActiveWorkbook.Close SaveChanges:=True Application.DisplayAlerts = True End If Next End Sub – user3357429 May 02 '20 at 13:05
  • 1
    Hi Samuel, i found it. above code is work well. i added ws.name in the loop, so it will save every sheet name. – user3357429 May 02 '20 at 13:08
  • FYI `"Sheet" & "*"` is the same as `"Sheet*"` – Samuel Everson May 02 '20 at 13:13