Copy and save sheet to new workbook

Question

Hi I have the below code which works however each time I run it, a message box appears with "code execution has been interrupted". When I press continue this is by passed however I want a method without the message box. Please see code below.

Sub SAVEProcImpReview()
    Application.DisplayAlerts = False
        Dim wb1 As Workbook
        Set wb1 = Workbooks("Action Plan Template")
        ThisWorkbook.Sheets("Proc Imp Review").Copy
        ActiveWorkbook.SaveAs "T:\Departments\Purchasing\Data\Vendor Management\Procurement Implementation\Procurement Review's\Proc Imp Review Week " & Format(Now, "ww") & " " & Year(Date) & " .xlsx"
        Workbooks("Proc Imp Review Week " & Format(Now, "ww") & " " & Year(Date) & " .xlsx").Close
    Application.DisplayAlerts = True
    wb1.Activate
End Sub

Answer 1

You could try this, with some minor modifications I do not get the problem you experience:

Sub SAVEProcImpReview()
    Application.DisplayAlerts = False
        Dim wb1 As Workbook
        Dim newWB As Workbook
        Set wb1 = Workbooks("Action Plan Template")
        wb1.Sheets("Proc Imp Review").Copy
        Set newWB = ActiveWorkbook
        newWB.SaveAs .SaveAs "T:\Departments\Purchasing\Data\Vendor Management\Procurement Implementation\Procurement Review's\Proc Imp Review Week " & Format(Now, "ww") & " " & Year(Date) & " .xlsx"
        newWB.Close
    Application.DisplayAlerts = True
    wb1.Activate
End Sub