如何用VBA保护两个子工作表并允许主工作表提取其数据

核心思路是利用VBA保护工作表时的UserInterfaceOnly参数，让子工作表仅锁定用户界面，允许VBA代码在无需解锁的前提下读取数据，同时只保护需要限制编辑的子表，保留主表的可访问性。

1. 修改工作簿关闭时的保护代码 #

替换原有的Workbook_BeforeClose事件代码，仅保护Project和Service工作表，并启用UserInterfaceOnly权限：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim xSheet As Worksheet
    Dim xPsw As String
    xPsw = "####" '替换为你的实际密码
    
    '仅对指定的两个子工作表应用保护
    For Each xSheet In ThisWorkbook.Worksheets(Array("Project", "Service"))
        'UserInterfaceOnly:=True 允许VBA操作受保护工作表，用户界面仍被锁定
        xSheet.Protect Password:=xPsw, UserInterfaceOnly:=True
    Next xSheet
    
    '如果需要保护主表但允许用户编辑，可取消注释下方代码（按需调整权限）
    'ThisWorkbook.Worksheets("Comprehensive").Protect _
    '    Password:=xPsw, UserInterfaceOnly:=True, _
    '    AllowFiltering:=True, AllowSorting:=True
End Sub

2. 保留（或优化）数据提取宏 #

设置UserInterfaceOnly后，原有copyFormat宏无需解锁子表即可直接运行。以下是优化后的版本，减少重复代码并清除复制状态：

Sub copyFormat()
    With ThisWorkbook
        '复制Project表的格式与数据到主表对应区域
        .Worksheets("Project").Range("D9:TJ28").Copy
        .Worksheets("Comprehensive").Range("D10:TJ29").PasteSpecial xlPasteFormats
        .Worksheets("Project").Range("A9:C28").Copy
        .Worksheets("Comprehensive").Range("A10:C29").PasteSpecial
        
        '复制Service表的格式与数据到主表对应区域
        .Worksheets("Service").Range("D9:TJ28").Copy
        .Worksheets("Comprehensive").Range("D30:TJ49").PasteSpecial xlPasteFormats
        .Worksheets("Service").Range("A9:C28").Copy
        .Worksheets("Comprehensive").Range("A30:C49").PasteSpecial
    End With
    
    Application.CutCopyMode = False '清除剪贴板的复制状态，避免弹窗提示
End Sub

关键说明 #

• UserInterfaceOnly:=True是实现需求的核心：该参数让工作表仅对用户界面上锁，VBA代码拥有完全的读写权限，无需提前解锁工作表。
• 由于UserInterfaceOnly设置不会随工作簿保存，因此在Workbook_BeforeClose事件中重新应用保护，能确保每次打开工作簿时权限设置生效。
• 主表Comprehensive未被保护（或按需设置宽松的保护权限），用户可直接访问并点击按钮触发宏，提取子表的最新数据。

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