遍历工作表删除冗余表，复制保留表为值时遇保护单元格报错的解决办法

嘿，这个问题我太熟了——处理Excel工作表时，保护状态简直是VBA脚本的“隐形坑”。针对你的需求（删除无用工作表+保留表转值），我给你梳理清楚解决方案，还有修改后的可用代码：

核心问题拆解 #

报错的本质是：当工作表或特定单元格处于锁定/保护状态且未获得修改权限时，执行粘贴值这类写入操作会触发权限错误。咱们分两种情况处理：

情况1：你知道工作表保护密码（最省心） #

如果这些受保护的表你有密码，直接先解除保护，操作完再恢复保护就行。这里推荐用UserInterfaceOnly:=True这个参数——设置后，VBA代码可以自由修改工作表，但用户手动操作还是受保护的，完美适配你的需求：

' 解除保护（替换成你的实际密码，没有密码就留空）
ws.Unprotect Password:="yourPasswordHere"
' 一键把所有内容转成值
ws.UsedRange.Value = ws.UsedRange.Value
' 重新保护，同时允许VBA操作
ws.Protect Password:="yourPasswordHere", UserInterfaceOnly:=True

情况2：不知道密码/无法解除保护（绕坑方案） #

如果遇到无权限解除保护的工作表，咱们用错误捕获+间接复制的方式绕过：

• 用On Error Resume Next捕获错误，避免程序崩溃
• 把整个工作表复制到新工作簿，再转值，最后替换原表（彻底绕开锁定限制）

适配你需求的完整代码 #

结合你的遍历、删表、转值需求，我整理了带错误处理的完整脚本，直接用就行：

Sub save()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim path As String
    Dim fname As String
    Dim fdate As Date
    Dim keepSheets As Variant
    Dim isKeep As Boolean
    
    ' 这里定义你需要保留的工作表名称，按需修改！
    keepSheets = Array("Instructions", "SalesData", "ReportSummary")
    
    ' 获取报告日期用于命名新文件
    fdate = Sheets("Instructions").Range("D1").Value
    path = ThisWorkbook.Path & "\"
    fname = "FinalReport_" & Format(fdate, "yyyy-mm-dd") & ".xlsx"
    
    ' 创建新工作簿操作，避免修改原文件（更安全）
    Set wb = Workbooks.Add
    
    ' 遍历原工作簿的所有工作表
    For Each ws In ThisWorkbook.Sheets
        isKeep = False
        ' 检查当前工作表是否在保留列表里
        For Each sheetName In keepSheets
            If ws.Name = sheetName Then
                isKeep = True
                Exit For
            End If
        Next sheetName
        
        If isKeep Then
            ' 复制保留的工作表到新工作簿
            ws.Copy After:=wb.Sheets(wb.Sheets.Count)
            Set ws = wb.Sheets(wb.Sheets.Count)
            
            ' 尝试解除保护（有密码就填，没有就留空）
            On Error Resume Next
            ws.Unprotect Password:="yourPasswordHere"
            On Error GoTo 0
            
            ' 尝试直接转值，失败就用粘贴值的方式
            On Error Resume Next
            ws.UsedRange.Value = ws.UsedRange.Value
            If Err.Number <> 0 Then
                ' 直接修改失败时，用复制粘贴值绕开锁定
                ws.UsedRange.Copy
                ws.Range("A1").PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
            End If
            On Error GoTo 0
            
            ' 重新保护工作表（可选，不需要就注释掉）
            ws.Protect Password:="yourPasswordHere", UserInterfaceOnly:=True
        End If
    Next ws
    
    ' 删除新工作簿默认的空白工作表
    Application.DisplayAlerts = False
    For Each ws In wb.Sheets
        If ws.Name = "Sheet1" And wb.Sheets.Count > 1 Then
            ws.Delete
        End If
    Next ws
    Application.DisplayAlerts = True
    
    ' 保存并关闭新工作簿
    wb.SaveAs Filename:=path & fname, FileFormat:=xlOpenXMLWorkbook
    wb.Close SaveChanges:=False
    
    MsgBox "搞定！文件已保存到：" & path & fname
End Sub

关键细节提醒 #

• 错误捕获：用On Error Resume Next包裹可能出错的操作，确保程序不会因为一个受保护的单元格就崩溃
• 新工作簿操作：全程在新工作簿里处理，不会修改原文件，更安全
• UserInterfaceOnly参数：一旦设置，后续VBA操作都不需要反复解除保护，非常方便

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