如何使用VBA将筛选后行的指定列复制到另一工作表

原代码存在的问题 #

• 不连续列的Range引用写法错误，Range("D, N" & r)无法正确定位到同行D、N两列的单元格
• 多余的整行复制语句Worksheets("ETM_ACS2").Rows(r).Copy会覆盖之前的复制范围，最终粘贴整行，不符合需求
• 频繁使用Activate、Select操作会拖慢代码运行速度，还容易引发工作表焦点错位的异常
• N列值直接用字符串和"100"比较，当N列存的是数值格式内容时，会出现比较逻辑错误

修正后可直接运行的代码 #

Public Sub CheckPrKey()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long, lastRowDashboard As Long, r As Long
    
    ' 绑定工作表对象，简化后续引用
    Set wsSource = ThisWorkbook.Worksheets("ETM_ACS2")
    Set wsTarget = ThisWorkbook.Worksheets("dashboard")
    
    ' 获取源表有效数据最后一行行号
    lastRow = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
    
    For r = 2 To lastRow
        ' 匹配筛选条件：I列值为"Y"，且N列数值小于100
        If wsSource.Range("I" & r).Value = "Y" And Val(wsSource.Range("N" & r).Value) < 100 Then
            ' 定位目标表下一个可写入的空行
            lastRowDashboard = wsTarget.Range("B" & wsTarget.Rows.Count).End(xlUp).Row + 1
            
            ' 方案1：直接赋值（推荐，不调用剪贴板，运行速度最快，仅复制值）
            wsTarget.Range("A" & lastRowDashboard).Value = wsSource.Range("D" & r).Value
            wsTarget.Range("B" & lastRowDashboard).Value = wsSource.Range("N" & r).Value
            
            ' 方案2：需要保留源单元格格式/公式时，注释掉上面两行，启用下面两行代码即可
            ' Union(wsSource.Range("D" & r), wsSource.Range("N" & r)).Copy
            ' wsTarget.Range("A" & lastRowDashboard).PasteSpecial Paste:=xlPasteAll
        End If
    Next r
    
    ' 使用复制方案时取消下一行注释，清空剪贴板状态
    ' Application.CutCopyMode = False
End Sub

补充说明 #

• 用Val()函数转换N列值做数值比较，避免文本格式数字、空值导致的判断逻辑错误
• 全程不需要激活工作表、选中单元格，代码运行时不会出现表格跳转的情况，稳定性更高
• 数据量超过千行时优先选直接赋值的方案，运行速度比Copy粘贴快10倍以上

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