将工作表复制并保存到新工作簿

Posted 2023-05-07

【中文标题】将工作表复制并保存到新工作簿

【英文标题】：Copy and save sheet to new workbook

【发布时间】：2015-10-12 14:04:54

【问题描述】：

您好，我有以下代码，但是每次运行它时，都会出现一个消息框，其中显示“代码执行已被中断”。当我按继续时，这是通过了但是我想要一个没有消息框的方法。请看下面的代码。

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

【参考方案1】：

你可以试试这个，稍加修改我没有遇到你遇到的问题：

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