如何实现Excel VBA宏动态排除指定工作表，无需硬编码表名？

实现逻辑 #

• 新建独立工作表存放待排除的工作表名称，建议将该表命名为Config，在表内A1:A10单元格逐行录入所有需要跳过的工作表名即可，区域内的空单元格会自动被忽略，不影响判断结果。
• 用工作表函数匹配的方式读取配置区域内容做排除判定，替代原有硬编码多条件判断的写法，后续增减排除名单不需要修改VBA代码，直接编辑配置表单元格内容就行。
• 移除原代码中依赖Select、ActiveCell的不稳定写法，直接通过单元格对象定位粘贴位置，避免因当前激活工作表/单元格不对导致的拷贝错位问题。

优化后完整代码 #

Sub BatchCopyWorksheetData()
    Dim Ws As Worksheet
    Dim configWs As Worksheet
    Dim excludeNameRng As Range
    Dim sourceRng As Range
    Dim pastePos As Range
    
    ' 请根据实际情况修改下方两个配置项
    ' 1. 存放排除名单的工作表名称
    Set configWs = ThisWorkbook.Worksheets("Config")
    ' 2. 排除名单所在的单元格区域
    Set excludeNameRng = configWs.Range("A1:A10")
    
    ' 初始化粘贴起始位置，对应原逻辑的起始粘贴点
    Set pastePos = Sheet26.Range("C6")
    
    For Each Ws In ThisWorkbook.Worksheets
        ' 自动跳过存放配置的工作表本身
        If Ws Is configWs Then GoTo NextIteration
        
        ' 匹配不到表名时才执行拷贝操作（匹配到代表在排除名单内，直接跳过）
        If IsError(Application.Match(Ws.Name, excludeNameRng, 0)) Then
            Set sourceRng = Ws.UsedRange
            ' 增加范围校验，避免工作表内容不足时触发越界错误
            If sourceRng.Rows.Count > 5 And sourceRng.Columns.Count > 3 Then
                sourceRng.Offset(5, 1).Resize(sourceRng.Rows.Count - 5, sourceRng.Columns.Count - 3).Copy pastePos
                ' 直接定位下一次粘贴的起始行，无需选中单元格
                Set pastePos = Sheet26.Cells(Sheet26.Rows.Count, "C").End(xlUp).Offset(1, 0)
            End If
        End If
NextIteration:
    Next Ws
End Sub

使用说明 #

• 如果存放排除名单的工作表不叫Config，把代码中Worksheets("Config")里的名称改成你实际用的表名即可
• 如果后续需要调整排除名单的录入范围，直接修改代码中Range("A1:A10")的区域地址
• 排除名单区域内不要留多余的空白非空单元格（比如不小心敲了空格的单元格），避免误匹配

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