如何基于单元格条件将指定列数据复制粘贴到另一Excel工作表

问题根源 #

代码核心错误是循环中复制区域写死了固定偏移，没有和当前匹配到的New所在行做绑定：
prd是Product列整个数据区域，prd.Offset(1).Resize(1,2)每次都只会取Product列第2行开始的1行2列内容，不会跟着循环里的c单元格动态变化，所以每次复制的都是第一次匹配到的行内容。

修复后的代码 #

直接用行号绑定当前匹配单元格，同时去掉冗余的Select操作，直接赋值比复制粘贴效率更高：

Sub AddNewProd()
    Dim tbl As ListObject
    Dim lr2 As Long
    Dim c As Range
    Dim rng As Range
    Dim currentRow As Long
    
    Set tbl = Sheets("sheet1").ListObjects("Table1")
    ' 直接用表列对象获取NewProd列遍历范围，稳定性更高
    Set rng = tbl.ListColumns("NewProd").DataBodyRange
    ' 初始化sheet2的写入起始行
    lr2 = Sheets("sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row + 1
    
    For Each c In rng
        ' 增加大小写、空格兼容处理，避免匹配漏判
        If UCase(Trim(c.Value)) = "NEW" Then
            currentRow = c.Row ' 获取当前匹配到的行号
            ' 直接赋值，不需要操作剪贴板
            Sheets("sheet2").Range("A" & lr2).Value = tbl.DataBodyRange(currentRow - tbl.HeaderRowRange.Row, tbl.ListColumns("Product").Index).Value
            Sheets("sheet2").Range("B" & lr2).Value = tbl.DataBodyRange(currentRow - tbl.HeaderRowRange.Row, tbl.ListColumns("Desc").Index).Value
            lr2 = lr2 + 1 ' 写入行号自增
        End If
    Next c
End Sub

关键优化点 #

• 直接用表格列对象获取遍历范围，不用硬编码列号AS，表结构调整时代码不需要修改
• 去掉了所有Select、Copy、Paste操作，运行速度更快，不会干扰剪贴板
• 行号计算和表格表头行绑定，即使表格插入了非数据行也不会出现偏移错误

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