EXcelVBA另存之后删除按钮及宏代码

Sub S_生成上报表()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    this_wb_name = ThisWorkbook.Name
    bm = "备份"
    p_ath = ThisWorkbook.Path & "\":     f_name = "绩效统计报表_" & bm & ".xls"
    Workbooks.Add
    On Error Resume Next
    ActiveWorkbook.SaveAs FileName:=p_ath & f_name
    On Error GoTo 0
    new_wb_name = f_name
    With Workbooks(this_wb_name)
        Dim shet As String, i As Integer
        Application.DisplayAlerts = False
        For Each sht In .Sheets
            sht.Copy after:=Workbooks(new_wb_name).Sheets(3)
        Next sht
    End With
    Windows(new_wb_name).Activate
    For Each sht In Workbooks(this_wb_name).Sheets: sht.Visible = xlSheetVisible: Next
    Workbooks(Workbooks.Count).Worksheets("Sheet3").Delete
    Workbooks(Workbooks.Count).Worksheets("Sheet2").Delete
    Workbooks(Workbooks.Count).Worksheets("Sheet1").Delete
    With Workbooks(Workbooks.Count) '以下开始删除VBA代码
        Dim vbcCom, Vbc
        Set vbcCom = .VBProject.VBComponents
        For Each Vbc In vbcCom
            If Vbc.Name Like "Sheet*" Or Vbc.Name Like "This*" Then
                Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines