VBA技术需求：按关键词复制行到Sheet2并从B列开始粘贴

嘿，这个调整超简单！你只需要修改代码里粘贴目标的起始列位置就行——原来的代码是把内容放到Sheet2的A列（列索引1），改成B列（列索引2）就搞定了。

我把你的代码补全并修改好了，直接用就行：

Sub EFP()
    Dim keyword As String
    keyword = Sheets("Results").Range("B3").Value
    
    Dim countRows1 As Long, endRows1 As Long, countRows2 As Long
    countRows1 = 3 'Data工作表中数据集的第一行
    endRows1 = 500 'Data工作表中数据集的最后一行
    countRows2 = 6 '开始写入匹配行的第一行
    
    Dim j As Long
    For j = countRows1 To endRows1
        ' 这里假设你是匹配Data工作表A列的内容，根据实际情况修改列号
        If InStr(1, Sheets("Data").Cells(j, 1).Value, keyword, vbTextCompare) > 0 Then
            ' 核心修改：把粘贴目标从A列（Cells(countRows2, 1)）改成B列（Cells(countRows2, 2)）
            Sheets("Data").Rows(j).Copy Destination:=Sheets("Sheet2").Cells(countRows2, 2)
            countRows2 = countRows2 + 1 ' 写完一行后，自动跳到下一行
        End If
    Next j
    
    ' 清理剪贴板，避免一直显示复制状态
    Application.CutCopyMode = False
End Sub

关键修改点说明 #

• 如果你的代码之前用的是PasteSpecial方法，比如：

  Sheets("Data").Rows(j).Copy
  Sheets("Sheet2").Cells(countRows2, 1).PasteSpecial xlPasteValues
  

  只需要把Cells(countRows2, 1)改成Cells(countRows2, 2)就可以了，其他逻辑不变。
• 如果你是匹配Data工作表里的其他列（比如B列），记得把判断语句里的Cells(j, 1)改成对应的列号（比如Cells(j, 2)）。
• vbTextCompare是不区分大小写的匹配规则，如果需要严格区分大小写，换成vbBinaryCompare或者直接去掉这个参数就行。

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