Method 'SaveAs' of object '_Workbook" failed Run-time Error 1004

[2clacaze]

Sub SaveWOWithNewName()


Dim strNew As String
Dim F6 As Range

strNew = "C:\Users\AdminAssist\Dropbox\Work Orders\Work Order Index\@1.xlsm"

Application.ScreenUpdating = False

With ActiveSheet
Set F6 = .Range("F6")
.Copy
End With

ActiveWorkbook.SaveAs Replace(strNew, "@1", F6.Value), FileFormat:=xlOpenXMLWorkbookMacroEnabled
With ActiveSheet
F6.Value = F6.Value + 1
.Range("A9:G19,B4:B7,E20,E48,F7").ClearContents
End With

Application.ScreenUpdating = True

Set F6 = Nothing

End Sub

I get the error message "Run-time Error 1004: Method 'SaveAs' of object '_Workbook' failed. Debugger takes me to bold line above. Please Help...So Close!

 

[2clacaze]

So it's all sorted now? Maybe worth naming the cell and referencing that named range in your code instead of a particular cell.

No. Still gives me the msgbox error associated with the same debug line. I have only verified for all of you that the cell in question is, in fact, not blank

 

[Trebor76]

OK try this where the code will only try and create the new file if the two conditions I have noted have been met:

Option Explicit
Sub SaveWOWithNewName()
 
    Dim strNew As String
    Dim F6 As Range
    
    strNew = "C:\Users\AdminAssist\Dropbox\Work Orders\Work Order Index\@1.xlsm"
    
    Application.ScreenUpdating = False
     
    'The following two conditions must both be met before attempting to create and save a new file
    If Len(ActiveSheet.Range("F6")) = 0 Then 'Condition 1 - there must be something in cell F6 on the active tab
        MsgBox "There is no proposed file name in cell F6 of this tab." & vbNewLine & "Please enter a prosed file name in cell F6 and try again.", vbExclamation
        Exit Sub
    ElseIf IsNumeric(ActiveSheet.Range("F6")) = False Then 'Condition 2 - the entry in cell F6 must ne numeric
        MsgBox "The entry in cell F6 of this tab is not numeric as so cannot be incremented by one." & vbNewLine & "Please enter a number in cell F6 and try again.", vbExclamation
        Exit Sub
    End If
    
    'If we get here should be OK to save the tab as a separate file
     With ActiveSheet
        Set F6 = .Range("F6")
        .Copy
     End With
    
    ActiveWorkbook.SaveAs Replace(strNew, "@1", F6.Value), FileFormat:=xlOpenXMLWorkbookMacroEnabled
    With ActiveSheet
        F6.Value = F6.Value + 1
        .Range("A9:G19,B4:B7,E20,E48,F7").ClearContents
    End With
    
    Application.ScreenUpdating = True
    
    Set F6 = Nothing

End Sub

 

[2clacaze]

Looks like a beaut of a Macro. I'm getting to understand the language a little more. When I run it now, I get a 'Compile Error: Expected End Sub' with the debugger going to the last line, 'End With' . That's weird, right? Why would it give me an error for something it expected?

Option Explicit
Sub SaveWOWithNewName()

Dim strNew As String
Dim F6 As Range

strNew = "C:\Users\AdminAssist\Dropbox\Work Orders\Work Order Index\@1.xlsm"

Application.ScreenUpdating = False

'The following two conditions must both be met before attempting to create and save a new file
If Len(ActiveSheet.Range("F6")) = 0 Then 'Condition 1 - there must be something in cell F6 on the active tab
MsgBox "There is no proposed file name in cell F6 of this tab." & vbNewLine & "Please enter a prosed file name in cell F6 and try again.", vbExclamation
Exit Sub
ElseIf IsNumeric(ActiveSheet.Range("F6")) = False Then 'Condition 2 - the entry in cell F6 must ne numeric
MsgBox "The entry in cell F6 of this tab is not numeric as so cannot be incremented by one." & vbNewLine & "Please enter a number in cell F6 and try again.", vbExclamation
Exit Sub
End If

'If we get here should be OK to save the tab as a separate file
With ActiveSheet
Set F6 = .Range("F6")
.Copy
End With

ActiveWorkbook.SaveAs Replace(strNew, "@1", F6.Value), FileFormat:=xlOpenXMLWorkbookMacroEnabled
With ActiveSheet
F6.Value = F6.Value + 1
.Range("A9:G19,B4:B7,E20,E48,F7").ClearContents
End With

Application.ScreenUpdating = True

Set F6 = Nothing

End Sub

 

[2clacaze]

Ok. I've got it figured to work, kinda. Had to unmerge a lot of cells to allow the contents to be erased. Therefore, I had to add all of my cells into the line. So, it works well, just in reverse. When I run the macro with a Value of '12345' in cell F6, I indeed get a new work order with that value as its title. however, the information stayed in the WO.Master (with the Value of F6 increasing by one to 12346, thank you!) but it cleared contents from the new sheet rather that clearing my master. Once I fill information in a worksheet and activate the macro, I need it to save that file as 'Value.F6', then clear my master copy and increase 'Value.F6' by one. We are close, but I don't know how to swap the targets. Code below:



Option Explicit
Sub SaveWOWithNewName()

Dim strNew As String
Dim F6 As Range

strNew = "C:\Users\AdminAssist\Dropbox\Work Orders\Work Order Index\@1.xlsm"

Application.ScreenUpdating = False

'The following two conditions must both be met before attempting to create and save a new file
If Len(ActiveSheet.Range("F6")) = 0 Then 'Condition 1 - there must be something in cell F6 on the active tab
MsgBox "There is no proposed file name in cell F6 of this tab." & vbNewLine & "Please enter a prosed file name in cell F6 and try again.", vbExclamation
Exit Sub
ElseIf IsNumeric(ActiveSheet.Range("F6")) = False Then 'Condition 2 - the entry in cell F6 must ne numeric
MsgBox "The entry in cell F6 of this tab is not numeric as so cannot be incremented by one." & vbNewLine & "Please enter a number in cell F6 and try again.", vbExclamation
Exit Sub
End If

'If we get here should be OK to save the tab as a separate file
With ActiveSheet
Set F6 = .Range("F6")
.Copy
End With

ActiveWorkbook.SaveAs Replace(strNew, "@1", F6.Value), FileFormat:=xlOpenXMLWorkbookMacroEnabled
With ActiveSheet
F6.Value = F6.Value + 1
.Range("A9:F19,B4:D7,C20:F20,C23:D23,A24:D24,A25:D25,E20,D48,F7:I7").ClearContents
End With
End Sub

 

[Trebor76]

I should have though to ask you if you were using merged cells as these are a big no-no for code. It's best to use Centre Across Selection instead. That was probably the issue from the start.

In any case I have written the following to toggle back the original workbook after the new one has been created:

Option Explicit
Sub SaveWOWithNewName()

    Dim strNew As String
    Dim F6 As Range
    Dim wbMyWorkbook As Workbook
    
    strNew = "C:\Users\AdminAssist\Dropbox\Work Orders\Work Order Index\@1.xlsm"
        
    Application.ScreenUpdating = False
    
    'The following two conditions must both be met before attempting to create and save a new file
    If Len(ActiveSheet.Range("F6")) = 0 Then 'Condition 1 - there must be something in cell F6 on the active tab
        MsgBox "There is no proposed file name in cell F6 of this tab." & vbNewLine & "Please enter a prosed file name in cell F6 and try again.", vbExclamation
        Exit Sub
    ElseIf IsNumeric(ActiveSheet.Range("F6")) = False Then 'Condition 2 - the entry in cell F6 must ne numeric
        MsgBox "The entry in cell F6 of this tab is not numeric as so cannot be incremented by one." & vbNewLine & "Please enter a number in cell F6 and try again.", vbExclamation
        Exit Sub
    End If
    
    'If we get here should be OK to save the tab as a separate file
    Set wbMyWorkbook = ThisWorkbook
    With ActiveSheet
        Set F6 = .Range("F6")
        .Copy
    End With
    
    ActiveWorkbook.SaveAs Replace(strNew, "@1", F6.Value), FileFormat:=xlOpenXMLWorkbookMacroEnabled
    wbMyWorkbook.Activate
    With ActiveSheet
        F6.Value = F6.Value + 1
        .Range("A9:F19,B4:D7,C20:F20,C23:D23,A24:D24,A25:D25,E20,D48,F7:I7").ClearContents
    End With
    
    Set wbMyWorkbook = Nothing
    Set F6 = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert

 

[2clacaze]

Works Great! Thank you so much for your help Robert. I will look for Trebor76 for good answers in the future

 

[Trebor76]

Thanks for letting us know and you're welcome