VBA技术问询：复制列区域值至指定工作表并删除重复项

作为VBA新手遇到这种问题很正常，我来帮你拆解步骤并给出可直接使用的代码，同时解释每个部分的作用，方便你理解和调试：

核心思路 #

• 明确源工作表（当前活动表）和目标工作表（要追加数据的表）
• 定位目标表中现有数据的最后一行，确保新数据追加在列表末尾
• 复制源区域的值到目标表的空白行
• 对目标表的完整数据范围执行去重操作

完整VBA代码 #

Sub CopyAndRemoveDuplicates()
    ' 声明变量，方便后续修改和调试
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim sourceRange As Range
    Dim lastRowTarget As Long
    Dim targetFullRange As Range
    
    ' 1. 定义源工作表和目标工作表
    Set wsSource = ActiveSheet ' 当前活动工作表
    Set wsTarget = ThisWorkbook.Worksheets("目标列表") ' 替换成你的目标表名称
    
    ' 2. 定义要复制的特定单元格区域，比如A2:C10，根据你的实际需求修改
    Set sourceRange = wsSource.Range("A2:C10")
    
    ' 3. 找到目标表中数据的最后一行（以A列为基准，可根据实际列调整）
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    
    ' 4. 将源区域的值粘贴到目标表的下一行（仅粘贴值，避免格式干扰）
    sourceRange.Copy
    wsTarget.Cells(lastRowTarget + 1, "A").PasteSpecial Paste:=xlPasteValues
    
    ' 5. 定义目标表的完整数据范围（包含刚新增的内容）
    Set targetFullRange = wsTarget.Range("A1:C" & wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row)
    
    ' 6. 删除重复项：Columns参数设置判断重复的列（比如Array(1,2,3)代表A、B、C列），Header根据是否有表头选择xlYes/xlNo
    targetFullRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
    
    ' 清除剪贴板，避免后续操作出现弹窗提示
    Application.CutCopyMode = False
    
    ' 操作完成提示
    MsgBox "数据复制并去重完成！"
End Sub

关键修改点（根据你的实际情况调整） #

• 目标表名称：把"目标列表"改成你实际的工作表名称，比如"历史数据"
• 源区域：把"A2:C10"改成你要复制的特定单元格范围
• 去重判断列：如果只需要根据A列判断重复，就把Columns:=Array(1,2,3)改成Columns:=Array(1)
• 表头设置：如果目标表没有表头，把Header:=xlYes改成Header:=xlNo

新手调试建议 #

1. 分步执行：按F8键逐行运行代码，观察每一步的效果，比如看lastRowTarget是否正确获取了目标表的最后一行
2. 检查变量值：选中变量（比如lastRowTarget），右键选择“添加监视”，可以实时查看变量的数值
3. 手动验证：先手动复制粘贴一次，确认源区域和目标位置是否正确，再用代码执行对比结果
4. 错误排查：如果运行报错，注意看错误提示，比如常见的“下标越界”通常是因为目标表名称写错了

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