Excel VBA按指定列单元格值复制整行至新工作表代码问题修复

原代码运行不符合预期的核心问题有两处：

• 匹配到值为"Yes"的单元格后，复制行时调用的是ActiveCell.EntireRow，ActiveCell指代的是代码运行前光标停留的激活单元格，和当前遍历到的匹配单元格无关联，这是复制错误行、重复粘贴相同内容的直接原因
• 代码通过Activate、Select反复切换工作表、选中单元格的写法，强依赖运行时的界面焦点状态，很容易出现定位偏差，稳定性极差

Sub CopyMatchedRows()
    Dim rng As Range, cell As Range
    Dim shtSource As Worksheet, shtTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    
    ' 绑定源数据表和目标存储表
    Set shtSource = Worksheets("Output")
    Set shtTarget = Worksheets("Callouts")
    
    ' 读取源表R列最后一行有效数据行号
    With shtSource
        lastRowSource = .Range("R" & .Rows.Count).End(xlUp).Row
    End With
    If lastRowSource < 2 Then lastRowSource = 2
    Set rng = shtSource.Range("R2:R" & lastRowSource)
    
    ' 遍历匹配，全程无需激活选中工作表
    For Each cell In rng
        ' 增加格式、空格兼容处理，避免漏匹配
        If Trim(CStr(cell.Value)) = "Yes" Then
            ' 定位目标表下一个空粘贴行
            lastRowTarget = shtTarget.Range("A" & shtTarget.Rows.Count).End(xlUp).Row
            If shtTarget.Cells(lastRowTarget, 1).Value = "" Then
                ' 目标表为空时从第一行开始粘贴
                cell.EntireRow.Copy
                shtTarget.Range("A" & lastRowTarget).PasteSpecial Paste:=xlPasteValues
            Else
                ' 目标表已有数据时从下一个空行开始粘贴
                cell.EntireRow.Copy
                shtTarget.Range("A" & lastRowTarget).Offset(1).PasteSpecial Paste:=xlPasteValues
            End If
        End If
    Next
    
    ' 清除剪贴板状态
    Application.CutCopyMode = False
End Sub

• 所有对象、变量显式声明绑定，完全不使用ActiveCell、ActiveSheet这类随界面状态变化的不稳定对象，从根源避免定位错误
• 移除所有Activate、Select操作，直接通过对象引用操作单元格，运行速度更快，不会因为运行时鼠标点选其他位置导致出错
• 匹配逻辑增加Trim去除前后空格、CStr统一格式处理，避免单元格值带不可见空格、存储为非文本格式时出现漏匹配
• 增加目标表为空时的行号判断，避免第一次粘贴时默认跳过第一行
• 运行结束后清除剪贴板复制状态，避免残留操作影响后续编辑

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