Excel VBA如何查找指定字符串并将对应行部分内容粘贴到N3起始位置

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

Sub btnFind_Click()
    Dim strLastRow As Long
    Dim rngC As Range
    Dim strToFind As String, FirstAddress As String
    Dim wSht As Worksheet
    Application.ScreenUpdating = False

    Set wSht = Worksheets("NewS")
    strToFind = InputBox("Enter the value to find")

    With ActiveSheet.Range("A1:A121")
        Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
        If Not rngC Is Nothing Then
            FirstAddress = rngC.Address
            Do
                ' 确定粘贴行：首次从N3开始，后续自动向下追加
                If wSht.Range("N3") = "" Then
                    strLastRow = 3
                Else
                    strLastRow = wSht.Range("N" & wSht.Rows.Count).End(xlUp).Row + 1
                End If
                
                ' 仅粘贴数值，且清除查找目标字符串内容
                rngC.EntireRow.Copy
                wSht.Range("N" & strLastRow).PasteSpecial Paste:=xlPasteValues
                wSht.Range("N" & strLastRow).ClearContents
                
                Set rngC = .FindNext(rngC)
            Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
        End If
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Finished"
End Sub

修改点说明 #

• 修正了原代码行数变量strLastRow的类型错误，由字符串类型改为长整型，避免行数计算异常
• 调整粘贴位置逻辑：首次匹配结果从NewS表N3单元格开始粘贴，后续结果自动在N列向下追加，符合需求的起始位置要求
• 实现仅保留其余列数值的要求：整行粘贴数值后，直接清空当前粘贴行N列的内容（该位置对应原匹配到的目标字符串），不会保留查找的目标内容
• 补充了屏幕更新恢复、剪切板清空逻辑，避免Excel出现残留选中状态的问题

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