执行xlPasteValues粘贴值后，打开另存的工作簿出现报错求助

核心问题点 #

• 直接修改原工作簿数据：代码先将当前工作簿的所有工作表替换为值，再执行另存操作，这会破坏原工作簿的原始数据；若保存过程中出现异常，还可能导致原文件损坏。
• 空工作表触发错误：如果某个工作表完全为空，Cells.Find会返回Nothing，后续调用.Row或.Column会直接报错中断代码，导致生成的文件不完整，打开时出现损坏提示。
• 保存逻辑不符合需求：使用ThisWorkbook.SaveAs是将原工作簿重命名保存，而非创建全新的工作簿，违背了“生成仅含值的新工作簿”的初衷。

修正后的代码 #

Sub CopyPasteValuesToNewWorkbook()
    With Application
        .Calculation = xlCalculationManual
        .DisplayStatusBar = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Dim sourceWs As Worksheet
    Dim newWb As Workbook
    Dim newWs As Worksheet
    Dim lastRow As Long, lastColumn As Long
    Dim rng As Range

    ' 创建全新的空白工作簿
    Set newWb = Workbooks.Add(xlWBATWorksheet)

    ' 删除新工作簿默认的空白工作表（避免多余表）
    Application.DisplayAlerts = False
    newWb.Worksheets(1).Delete
    Application.DisplayAlerts = True

    ' 遍历原工作簿的所有工作表，复制值到新工作簿
    For Each sourceWs In ThisWorkbook.Worksheets
        ' 复制源工作表到新工作簿
        sourceWs.Copy After:=newWb.Worksheets(newWb.Worksheets.Count)
        Set newWs = newWb.Worksheets(newWb.Worksheets.Count)

        ' 捕获空工作表的错误
        On Error Resume Next
        lastRow = newWs.Cells.Find(what:="*", _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row
        lastColumn = newWs.Cells.Find(what:="*", _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious).Column
        On Error GoTo 0

        ' 仅处理非空工作表，替换为值
        If lastRow > 0 And lastColumn > 0 Then
            Set rng = newWs.Range(newWs.Cells(1, 1), newWs.Cells(lastRow, lastColumn))
            rng.Value = rng.Value ' 直接赋值比复制粘贴更高效
        End If
    Next sourceWs

    ' 恢复应用程序默认设置
    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayStatusBar = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    ' 处理保存逻辑
    Dim fName As Variant
    Dim currentDate As String
    currentDate = Format(Date, "YYYY-MM-DD")

    fName = Application.GetSaveAsFilename("......\" _
    & "...." & " " & currentDate & ".xlsx", _
    "Excel files,*.xlsx", _
    1, _
    "Select your folder and filename")

    ' 用户取消保存时关闭新工作簿
    If TypeName(fName) = "Boolean" Then
        newWb.Close SaveChanges:=False
        Exit Sub
    End If

    Application.DisplayAlerts = False
    newWb.SaveAs Filename:=fName, FileFormat:=51
    Application.DisplayAlerts = True
End Sub

关键改进说明 #

• 保留原工作簿完整性：通过创建全新工作簿存储值，完全不修改原文件的任何数据。
• 兼容空工作表：添加错误捕获逻辑，避免空工作表导致的代码中断，保证新工作簿能正常生成。
• 高效值替换：用rng.Value = rng.Value替代Copy/PasteSpecial，执行速度更快且不会占用剪贴板。
• 安全的保存流程：用户取消保存时自动关闭未保存的新工作簿，避免残留临时文件。

内容的提问来源于stack exchange，提问作者Marcel