Excel宏复制粘贴重复数据求助：AutoFilter.Range.Copy后数据重复

看起来你的核心问题出在复制筛选数据的方式以及粘贴时的位置不确定性上，结合你的代码和描述，我来拆解问题并给出修复方案：

问题根源分析 #

• 错误的复制范围：你使用ActiveSheet.AutoFilter.Range.Copy时，这个范围是整个应用了筛选的原始区域（包括被筛选隐藏的行），而不是仅筛选后可见的行。当粘贴到Sheet3时，那些隐藏的行也会被粘贴出来（因为Sheet3没有启用筛选），后续的删除操作可能没处理干净，导致计数错误。
• 粘贴位置不确定：直接用ActiveSheet.Paste依赖当前激活的单元格，如果Sheet3的选中位置不是A1（比如之前操作残留的选中状态），新数据会被追加到现有内容下方，造成重复。

修复后的代码及解释 #

我调整了你的代码，避免Activate/Select这类不稳定操作，明确复制可见行，并指定粘贴位置：

Sub FixDuplicateDataIssue()
    Dim wsSource As Worksheet, wsTemp As Worksheet, wsTarget As Worksheet
    Dim lrSource As Long, lrTemp As Long
    
    ' 初始化工作表对象（避免Activate/Select，提高稳定性）
    Set wsSource = ThisWorkbook.Sheets("Sheet2")
    Set wsTemp = ThisWorkbook.Sheets("Sheet3")
    Set wsTarget = ThisWorkbook.Sheets("Sheet5")
    
    ' 重置状态：清空剪贴板、关闭筛选、清空临时表
    Application.CutCopyMode = False
    wsSource.AutoFilterMode = False
    wsTemp.AutoFilterMode = False
    wsTemp.Cells.Clear
    
    ' 筛选Sheet2中的Category3记录
    lrSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    wsSource.Range("$A$1:$X$" & lrSource).AutoFilter Field:=2, Criteria1:="Category3"
    
    ' 复制仅可见的筛选行（包含表头）
    wsSource.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
    
    ' 指定粘贴到Sheet3的A1位置，避免位置不确定问题
    wsTemp.Range("A1").PasteSpecial xlPasteAll ' 可根据需求换成xlPasteValuesAndNumberFormats
    
    ' 清空剪贴板
    Application.CutCopyMode = False
    
    ' 处理Sheet3的筛选和删除
    lrTemp = wsTemp.Cells(wsTemp.Rows.Count, "A").End(xlUp).Row
    wsTemp.Range("$A$1:$X$" & lrTemp).AutoFilter Field:=5, Criteria1:="Filter-criteria"
    
    ' 删除不符合条件的行（加入错误处理，防止无可见行时报错）
    On Error Resume Next
    wsTemp.Range("$A$1:$X$" & lrTemp).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0
    
    wsTemp.AutoFilterMode = False
    
    ' 更新Sheet5的统计数据（修正拼写错误）
    wsTarget.Range("C64").Value = lrTemp - 1 ' 减去表头行
    wsTarget.Range("D64").Value = Application.WorksheetFunction.CountIf(wsTemp.Range("B:B"), "Category3")
    wsTarget.Range("E64").Value = Application.WorksheetFunction.CountIf(wsTemp.Range("T:T"), "Example Category")
    wsTarget.Range("F64").Value = Application.WorksheetFunction.CountIf(wsTemp.Range("T:T"), "Example Category")
    wsTarget.Range("G64").Value = Application.WorksheetFunction.CountIf(wsTemp.Range("T:T"), "Example Category")
End Sub

关键改进点 #

• 替换Activate/Select为工作表对象：直接引用工作表，避免因激活状态变化导致的操作错误，这是VBA编写的最佳实践。
• 复制可见行：使用SpecialCells(xlCellTypeVisible)确保只复制筛选后显示的行，不会把隐藏的无关数据带过来。
• 指定粘贴位置：明确粘贴到wsTemp.Range("A1")，彻底避免粘贴位置不确定的问题。
• 增加错误处理：删除行时加入On Error Resume Next，防止没有符合条件的行时抛出运行时错误。
• 修正拼写错误：原代码里的"Catgeory"拼写错误已统一修正，避免统计公式失效。

额外建议 #

• 尽量避免使用Copy/Paste操作，直接通过单元格赋值的方式传输数据，效率更高且更稳定。
• 可以给工作表重命名为更有意义的名称（比如"数据源"、"临时处理表"），避免Sheet2/Sheet3这种模糊名称，提高代码可读性。

内容的提问来源于stack exchange，提问作者K.EL