save excel file as copy to current folder VBA issue

craig schultz

New Member
Joined
Dec 4, 2014
Messages
47
Hi, I wonder if anyone could help me please.

I have a code below which saves the excel file as a copy to its current location and renames the file 'customer copy'

This works fine the first time, but when a file with the same name exists in the current location and I chose the option 'No' or 'Cancel' I get a run-time error.

I'm sure its a simple fix but I am fairly new to VBA and would really appreciate any help.

Sub Customercopy()
ActiveSheet.Unprotect
' Copy activesheet to the new workbook
ActiveSheet.Copy
Columns("H:J").Select
Selection.Delete Shift:=xlToLeft
Cells.Validation.Delete

Dim btn As Shape
For Each btn In ActiveSheet.Shapes
If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
Next

'Save new workbook as MyWb.xls(x) into the folder where ThisWorkbook is stored
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Proprietary Equipment Bom Customer Copy", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Bom has been saved with 'Denco Reference Only' Columns and All Previous Revisions Removed. Saved in Current Bom File " & ActiveWorkbook.FullName & vbLf & "Press OK to close it"

' Close the saved copy
ActiveWorkbook.Close False

ActiveSheet.Protect
End Sub

Many thanks

Craig
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
am assuming the question that you are answering "No" to is something like "filename already exists. do you want to replace the current file" ???
 
Upvote 0
Hi,
see if this update to your code does what you want

Code:
Sub Customercopy()
    Dim FullFileName As String
    Dim btn As Shape
    
'copy name & filepath
    FullFileName = ThisWorkbook.Path & "\Proprietary Equipment Bom Customer Copy.xlsm"
    
    If Dir(FullFileName, vbDirectory) = vbNullString Then
        Application.ScreenUpdating = False
        
' Copy activesheet to the new workbook
        With ActiveSheet
            .Unprotect
            .Copy
        End With
        
        Columns("H:J").Delete Shift:=xlToLeft
        Cells.Validation.Delete
        
    
        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next
        
'Save new workbook as MyWb.xls(x) into the folder where ThisWorkbook is stored
        
        With ActiveWorkbook
            .SaveAs FullFileName, xlOpenXMLWorkbookMacroEnabled
            .Close False
        End With
        
        Application.ScreenUpdating = True
'inform user
        MsgBox "Bom has been saved with 'Denco Reference Only'" & Chr(10) & _
        "Columns and All Previous Revisions Removed." & Chr(10) & Chr(10) & _
        "Saved in Current Bom File " & FullFileName & vbLf & "Press OK to close it", 64, "File Saved"
        
        ActiveSheet.Protect
    Else
'file exists
        MsgBox FullFileName & Chr(10) & "File Exists!", 16, "File Exists"
        
    End If
End Sub

I have kept the FileFormat as marco enabled workbook (xlsm) as I assume that is what you want - If though workbook contains no macros you could save it as xlsx non macro workbook.

Hope helpful

Dave
 
Upvote 0
Thanks, yes I would like it kept as xlsm.

I would still like for the file to be overwritten if they choose to which currently works. But when the message "filename already exists. do you want to replace the current file" the "No" & "cancel" buttons create an error?

Many thanks

Craig
 
Upvote 0
Thanks, yes I would like it kept as xlsm.

I would still like for the file to be overwritten if they choose to which currently works. But when the message "filename already exists. do you want to replace the current file" the "No" & "cancel" buttons create an error?

Many thanks

Craig


Try following:

Code:
Sub Customercopy()
    Dim FullFileName As String
    Dim Response As VbMsgBoxResult
    Dim btn As Shape
    
'copy name & filepath
    FullFileName = ThisWorkbook.Path & "\Proprietary Equipment Bom Customer Copy.xlsm"
    
    If Not Dir(FullFileName, vbDirectory) = vbNullString Then
    
'file exists
        Response = MsgBox(FullFileName & Chr(10) & "File Exists!" & Chr(10) & "Do You Want To Overwrite The File?", 36, "File Exists")
        If Response = vbNo Then Exit Sub
    End If
        
        With Application
            .ScreenUpdating = False: .DisplayAlerts = False
        End With
        
' Copy activesheet to the new workbook
        With ActiveSheet
            .Unprotect
            .Copy
        End With
        
        Columns("H:J").Delete Shift:=xlToLeft
        Cells.Validation.Delete
        
    
        For Each btn In ActiveSheet.Shapes
            If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
        Next
        
'Save new workbook as MyWb.xls(x) into the folder where ThisWorkbook is stored
        
        With ActiveWorkbook
            .SaveAs FullFileName, xlOpenXMLWorkbookMacroEnabled
            .Close False
        End With
        
        Application.ScreenUpdating = True
'inform user
        MsgBox "Bom has been saved with 'Denco Reference Only'" & Chr(10) & _
        "Columns and All Previous Revisions Removed." & Chr(10) & Chr(10) & _
        "Saved in Current Bom File " & FullFileName & vbLf & "Press OK to close it", 64, "File Saved"
        
        ActiveSheet.Protect
        
        Application.DisplayAlerts = True
End Sub

I have only included the Yes No Buttons - Yes overwrites the File No exits the code.


Dave
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top