求助：Excel VBA宏实现跨工作表复制列数据并去重

原代码问题分析 #

1. 变量名错误：代码中使用了未定义的lCopyLastRow，实际定义的变量是CopyLastRow
2. 逻辑偏差：仅复制源表A列最后一行数据到目标表T2单元格，未遍历所有源数据，也未实现去重判断
3. 效率低下：遍历目标表整列（20列即T列）的所有单元格，会循环大量空单元格，拖慢运行速度

参考数据场景 #

• 源表：u_mapping.xlsx的Sheet1，A列是待复制的用户ID数据（首行是表头）
• 目标表：mapp_V1.xlsx的mapp工作表，D列是已存在的用户ID，需要将源表A列中未在D列出现过的数据，追加到T列末尾

修正后的完整VBA代码 #

Sub CopyUniqueData()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim lastRowSource As Long, lastRowDest As Long
    Dim sourceCell As Range, destCell As Range
    Dim isDuplicate As Boolean
    
    ' 绑定源工作表与目标工作表（确保两个文件已打开）
    Set wsSource = Workbooks("u_mapping.xlsx").Worksheets("Sheet1")
    Set wsDest = Workbooks("mapp_V1.xlsx").Worksheets("mapp")
    
    ' 获取源表A列最后一行、目标表D列最后一行的行号
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    lastRowDest = wsDest.Cells(wsDest.Rows.Count, "D").End(xlUp).Row
    
    ' 遍历源表A列的所有数据（从第2行开始，跳过表头）
    For Each sourceCell In wsSource.Range("A2:A" & lastRowSource)
        isDuplicate = False
        
        ' 检查目标表D列是否已存在当前数据
        For Each destCell In wsDest.Range("D2:D" & lastRowDest)
            If sourceCell.Value = destCell.Value Then
                isDuplicate = True
                Exit For ' 找到重复项，跳出内层循环
            End If
        Next destCell
        
        ' 非重复数据则追加到目标表T列末尾
        If Not isDuplicate Then
            lastRowDest = lastRowDest + 1 ' 更新目标表最后一行行号
            wsDest.Cells(lastRowDest, "T").Value = sourceCell.Value
            ' 若需保留源单元格格式，替换为：sourceCell.Copy wsDest.Cells(lastRowDest, "T")
        End If
    Next sourceCell
    
    MsgBox "数据复制完成，已自动跳过重复项！"
End Sub

代码关键说明 #

• 去重逻辑：通过双层循环比对源表数据与目标表D列数据，确保仅新增未出现过的内容
• 高效赋值：直接通过Value属性赋值比复制粘贴更快，若需保留格式可切换为Copy方法
• 动态行号：每次粘贴后更新目标表的最后一行行号，保证数据始终追加到末尾
• 表头处理：默认跳过首行表头，若你的表头位置不同，需修改代码中A2:A和D2:D的起始行号

使用注意事项 #

1. 运行宏前必须确保u_mapping.xlsx和mapp_V1.xlsx两个文件处于打开状态
2. 如果源表或目标表的表头不在第1行，需调整代码中数据区域的起始行号
3. 若要复制多列数据，可扩展内层逻辑，例如同时复制源表A、B列到目标表T、U列

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