How to remove Macro button when i copy a sheet into a new file.

[Ronald_Peters]

Hi All,

I need a little help,

I used the code from MrExcel Next invoice number podcast #1505 and it all works well,
Just when the new file is made it also copies the Macro buttons to the new file.
Is there a way to prevent this.

Thanks in advanced

Sub PostToRegister()

        Dim wb As Workbook:     Set wb = ThisWorkbook
        Dim ws1 As Worksheet:   Set ws1 = wb.Worksheets("Quotation")
        Dim ws2 As Worksheet:   Set ws2 = wb.Worksheets("Register")
        Application.ScreenUpdating = False
        
        ' Figure out which row is the next row.
        NextRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        ' Write the important values to Register sheet.
        '                                          collect 5 columns        Collect Date from I5     Collect Quotation# from G1..........
        ws2.Cells(NextRow, 1).Resize(1, 5).Value = Array(ws1.Range("I5"), ws1.Range("G1"), ws1.Range("B7"), ws1.Range("B9"), ws1.Range("I37"))
        
        
End Sub
Sub NextInvoice()

    ' Clear all cells for next Quotation.
    Application.ScreenUpdating = False
    Range("G1").Value = Range("G1").Value + 1
    Range("B7").MergeArea.ClearContents
    Range("B8").MergeArea.ClearContents
    Range("G8").MergeArea.ClearContents
    Range("B9").MergeArea.ClearContents
    Range("B10").MergeArea.ClearContents
    Range("A18:A34").ClearContents
    Range("B18:F34").ClearContents
    Range("I18:J34").ClearContents
    
End Sub

Sub CheckClient()

        ' Check if Client Name is filled out, if not stop saving.
        Dim wb As Workbook:     Set wb = ThisWorkbook
        Dim ws1 As Worksheet:   Set ws1 = wb.Worksheets("Quotation")

     If ws1.Range("B7") = "" Then
    MsgBox "cant leave Client name Empty"
    
    ClientCellSelection 'Execute Sub ClientCellSelection.
    
    Else: SaveWithNewName ' Else Execute Sub SaveWithNewName.
    
    End If
    
    
    
End Sub
    
    
    
Sub SaveWithNewName()

    Dim NewFN As Variant
    Dim strGenericFilePath       As String: strGenericFilePath = "/Users/ronaldpeters/Desktop/viewco/Quotations Version 1.xlsm\"  'Change this to the Path you want to save to ( without year and Client name )
    Dim strYear                  As String: strYear = Year(Date) & "/"
    Dim strFileName              As String: strFileName = "Quotation_"
    Dim strClient                As String: strClient = Range("B7") & "/"
    Dim strProjectName           As String: strProjectName = Range("B9") & "/"
    Dim strQuoteNumber           As String: strQuoteNumber = Range("G1")


    

    
' Check for year folder and create if needed.
If Len(Dir(strGenericFilePath & strYear, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYear
End If

    ' Check for Client folder and create if needed.
If Len(Dir(strGenericFilePath & strYear & strClient, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYear & strClient
End If

    ' Check for Projectname folder and create if needed.
If Len(Dir(strGenericFilePath & strYear & strClient & strProjectName, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYear & strClient & strProjectName
End If

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlAutomatic
    ThisWorkbook.CheckCompatibility = False
    
    PostToRegister ' Execute Sub PostToRegister.
    
    ' Save the File to destination folder.
       fldrname = strYear & strClient
       ActiveSheet.Copy
       NewFN = strGenericFilePath & strYear & strClient & strProjectName & strFileName & Range("G1").Value & ".xlsx"
       ActiveSheet.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
        
        NextInvoice 'Execute Sub NextInvoice.
    
    ' Popup Message
MsgBox "File Saved As: " & vbNewLine & strGenericFilePath & strYear & strClient & strProjectName & strFileName & strQuoteNumber

SaveWorkbook

End Sub
Sub SaveWorkbook()

ThisWorkbook.Save

End Sub
Sub ClientCellSelection()

 Range("B7").Select ' Select cell B7 Client name field

End Sub

 

[DanteAmor]

If you don't want to copy the images try this:
Before this line:
ActiveSheet.Copy

Put this line:
Application.CopyObjectsWithCells = False

_____________________________________________________________________
If you only want to delete an image
After this line:
ActiveSheet.Copy

Put this line:
ActiveSheet.DrawingObjects("image1").Delete

Note: Change "image1" by the name of the image you want to delete

 

[Ronald_Peters]

If you don't want to copy the images try this:
Before this line:
ActiveSheet.Copy

Put this line:
Application.CopyObjectsWithCells = False

_____________________________________________________________________
If you only want to delete an image
After this line:
ActiveSheet.Copy

Put this line:
ActiveSheet.DrawingObjects("image1").Delete

Note: Change "image1" by the name of the image you want to delete

Hi Dante Amor,
Works perfect ( application.copyOb.......... ).

Thanks for your help.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.