VBA开发诉求：排除指定工作表，复制动态区域数据至Master表

原代码的核心问题 #

你的代码存在几处关键错误和逻辑偏差，导致无法实现需求：

• 条件判断完全颠倒且语法错误：原代码是当工作表是Master/Index/Tracker Template时执行复制，但实际需要排除这三个表；同时or的语法错误，正确写法应该是每个条件都完整指定ws.Name = 名称。
• 复制范围不符合需求：原代码复制到列A的最后一行，而需求是复制到首个出现“Totals”的行，且范围应为A4:U而非A4:Q。
• 未处理空行与重复数据：没有过滤空行的逻辑，也未检查Master表中是否已存在相同数据，会导致无效数据和重复。
• 变量声明不规范：i, LastRowa, LastRowd As Long中仅LastRowd是Long类型，其余两个是Variant，可能引发类型错误。

修正后的完整代码 #

Sub CopySheetsToMaster()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim masterWs As Worksheet
    Dim lastRowMaster As Long, startRow As Long, endRow As Long
    Dim currentRow As Long, targetRow As Long
    Dim totalCell As Range
    Dim isDuplicate As Boolean
    
    ' 定义工作簿和Master工作表
    Set wb = ActiveWorkbook
    Set masterWs = wb.Sheets("Master")
    
    ' 获取Master表当前最后一行（列A）
    lastRowMaster = masterWs.Cells(masterWs.Rows.Count, "A").End(xlUp).Row
    ' 如果Master表为空，从第4行开始（和源表对齐），否则从下一行开始
    targetRow = IIf(lastRowMaster < 4, 4, lastRowMaster + 1)
    
    ' 遍历所有工作表
    For Each ws In wb.Sheets
        ' 排除指定的三个工作表
        Select Case ws.Name
            Case "Master", "Index", "Tracker Template"
                ' 跳过这些表
            Case Else
                ' 定位首个出现"Totals"的行（列A）
                Set totalCell = ws.Range("A:A").Find(What:="Totals", LookIn:=xlValues, LookAt:=xlWhole)
                If Not totalCell Is Nothing Then
                    endRow = totalCell.Row - 1 ' 取Totals行的上一行作为结束行
                Else
                    ' 如果没找到Totals，用列A的最后一行作为结束行
                    endRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                End If
                
                startRow = 4 ' 源数据从第4行开始
                ' 如果结束行小于起始行，跳过当前表（无数据）
                If endRow < startRow Then GoTo NextSheet
                
                ' 遍历源表的每一行，过滤空行和重复数据
                For currentRow = startRow To endRow
                    ' 检查当前行是否为空（判断A列是否有值，且整行A-U不全为空）
                    If Not IsEmpty(ws.Cells(currentRow, "A")) And _
                       Application.CountA(ws.Range(ws.Cells(currentRow, "A"), ws.Cells(currentRow, "U"))) > 0 Then
                        ' 检查是否重复：这里用A列的值作为标识，可根据需求修改为多列组合
                        isDuplicate = Not IsError(Application.Match(ws.Cells(currentRow, "A").Value, masterWs.Range("A:A"), 0))
                        
                        If Not isDuplicate Then
                            ' 复制A-U列的数据到Master表
                            masterWs.Range(masterWs.Cells(targetRow, "A"), masterWs.Cells(targetRow, "U")).Value = _
                                ws.Range(ws.Cells(currentRow, "A"), ws.Cells(currentRow, "U")).Value
                            targetRow = targetRow + 1 ' 目标行下移
                        End If
                    End If
                Next currentRow
        End Select
NextSheet:
    Next ws
    
    ' 清除剪贴板（避免残留复制状态）
    Application.CutCopyMode = False
    MsgBox "数据复制完成！", vbInformation
End Sub

关键逻辑说明 #

• 排除指定工作表：用Select Case清晰判断需要跳过的表，比多Or条件更易维护。
• 定位结束行：用Find方法精准找到首个“Totals”行，找不到则 fallback 到列A的最后一行，避免遗漏数据。
• 空行过滤：通过检查A列是否有值+整行A-U的非空单元格数量，确保只复制有效行。
• 去重逻辑：用Application.Match检查当前行的关键标识（这里用A列，可根据实际需求改为多列组合，比如ws.Cells(currentRow, "A").Value & ws.Cells(currentRow, "B").Value）是否已存在于Master表，避免重复。
• 高效赋值：直接通过单元格值赋值替代Copy/PasteSpecial，运行更快且避免剪贴板冲突。

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