CODEWITHSUNDEEP
vbaexcel
Matt Swanson
Matt Swanson

Reputation: 21

Excel VBA: Runtime Error 1004 When Deleting Sheet1

I'm still working on learning VBA, so this might be a dumb question, but I'm looking to loop through a workbook of ~ 90-95 sheets, break each out into its own workbook, and save it as the name of the worksheet from the original file.

The script works, but only if I comment out the .Worksheets(1).Delete, and I'm wondering why...It throws a 1004 error on both sheets that I'm running it against, but not in the same spot. The first sheet errors out on tab 4, the second on tab 40-something.

Right now I've got the FileNamePrefix variable set up to toggle, because I'm running this in the VBA window under "ThisWorkbook", since I haven't figured out how to run this macro from its own sheet, and choose the prefix based on the name/extension of the file it maps to. (AC comes to me as a .xlsm, CC as a .xlsx) That is still on my to-do, so no spoilers, please! :)

Macro:

Sub Sheet_SaveAs()
    Dim wb As Workbook
    Dim WS_Count As Integer
    Dim ActiveSheetName As String
    Dim ws As Worksheet
    Dim FileNamePrefix As String
    Dim FileName As String
    Dim FilePath As String
    'FileNamePrefix = "CC Dashboard "
    FileNamePrefix = "AC Dashboard "
    WS_Count = ActiveWorkbook.Worksheets.Count
    MsgBox (" This will create: " & WS_Count & " Files")
    For Each ws In ThisWorkbook.Worksheets
        Set wb = Workbooks.Add(xlWBATWorksheet)
        With wb
            ThisWorkbook.Worksheets(ws.Name).Copy After:=.Worksheets(.Worksheets.Count)
            Application.DisplayAlerts = False
            .Worksheets(1).Delete
            Application.DisplayAlerts = True
            .SaveAs ThisWorkbook.Path & "\" & FileNamePrefix & ws.Name
            .Close False
        End With
        ws.Name = FileNamePrefix & ws.Name
    Next
    MsgBox (" Done! ")
End Sub

Upvotes: 1

Views: 1400

Answers (1)

Frank Ball
Frank Ball

Reputation: 1126

So lets get rid of the Delete and just create the new file with only the worksheet you want. I also did a little clean up on your code.

Sub Sheet_SaveAs()
    Dim wb As Workbook
    Dim WS_Count As Integer
    Dim ActiveSheetName, FileNamePrefix, FileName, FilePath As String
    Dim ws As Worksheet

    'FileNamePrefix = "CC Dashboard "
    FileNamePrefix = "AC Dashboard "
    WS_Count = ActiveWorkbook.Worksheets.Count
    MsgBox (" This will create: " & WS_Count & " Files")
    For Each ws In ThisWorkbook.Worksheets
        ws.Copy 'this creates a new file with only the one sheet, so no Delete needed
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & FileNamePrefix & ws.Name
        ActiveWorkbook.Close False
    Next
    MsgBox (" Done! ")
End Sub

Upvotes: 1

Related Questions