Excel VBA技术求助：查找字符串后复制至指定单元格并循环遍历

核心修改方向 #

1. 将固定的复制目标替换为你指定的特定单元格
2. 把硬编码的遍历范围改为动态获取数据末尾，避免遗漏或多余遍历

情况1：所有匹配内容覆盖到同一个特定单元格（保留最后一个匹配项） #

如果需要把找到的内容都复制到同一个单元格（比如M1），修改后的代码如下：

Sub CopyToSpecificCell()
    Dim c As Range
    Dim lastRow As Long
    
    ' 动态获取B列最后一行有数据的行号
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    ' 遍历B列到K列的实际数据行
    For Each c In Range("B1:K" & lastRow)
        If InStr(1, c.Text, "Address:") > 0 Then
            ' 修改这里的Range("M1")为你的目标特定单元格
            c.Copy Destination:=Range("M1")
        End If
    Next c
End Sub

情况2：匹配内容依次复制到指定列的连续单元格（不覆盖） #

如果有多个匹配项，需要依次放到指定列（比如从M1开始往下排），可以添加计数器实现：

Sub CopyToSpecificColumn()
    Dim c As Range
    Dim lastRow As Long
    Dim targetRow As Long
    
    ' 初始化目标起始行
    targetRow = 1
    ' 动态获取数据最后一行
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    For Each c In Range("B1:K" & lastRow)
        If InStr(1, c.Text, "Address:") > 0 Then
            ' 复制到M列的第targetRow行，之后行数自增
            c.Copy Destination:=Range("M" & targetRow)
            targetRow = targetRow + 1
        End If
    Next c
End Sub

关键说明 #

• 把代码中的Range("M1")或Range("M" & targetRow)替换为你实际需要的特定单元格（比如Range("X5")）
• 动态获取lastRow的逻辑是从B列底部往上找第一个非空单元格，确保遍历范围精准覆盖所有数据行

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