VBA跨工作簿复制行故障：获取行号后无法完成复制粘贴

问题分析 #

你的代码能正确定位目标行号，但复制粘贴失败，核心原因是语法错误和对象引用不严谨，以下是修正后的完整代码：

Sub OpenCopy()
    Dim extractWB As Workbook
    Dim rowNum As Integer
    Dim OpenPath As String
    Dim OpenName As String
    
    ' 修正路径拼接，确保路径末尾有分隔符
    OpenPath = "C:\Users\Noon\Desktop\"
    OpenName = OpenPath & "Users_" & Format(Date, "YYYY-MM-DD") & ".xlsx"
    
    ' 打开目标工作簿并赋值给变量，避免依赖ActiveWorkbook
    Set extractWB = Workbooks.Open(Filename:=OpenName)
    
    Dim c As Range
    Dim FoundCell As Range
    
    ' 遍历原工作簿Status表A列的用户列表
    For Each c In ThisWorkbook.Sheets("Status").UsedRange.Columns("A").Cells
        ' 跳过空单元格
        If c.Value <> "" Then
            ' 在提取工作簿的DSV-Users表A列精确查找用户
            Set FoundCell = extractWB.Sheets("DSV-Users").Range("A:A").Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole)
            
            ' 找到匹配项才执行复制粘贴
            If Not FoundCell Is Nothing Then
                ' 复制匹配行到原工作簿Sheet2的对应行
                extractWB.Sheets("DSV-Users").Rows(FoundCell.Row).EntireRow.Copy _
                    Destination:=ThisWorkbook.Sheets("Sheet2").Cells(c.Row, 1)
            End If
        End If
    Next c
End Sub

关键修改点 #

• 修复路径拼接错误：原代码OpenPath末尾无分隔符，导致生成的文件名格式错误，现在添加\确保路径合法。
• 替换ActiveWorkbook为明确变量：将打开的工作簿赋值给extractWB，避免后续操作中ActiveWorkbook切换引发的错误。
• 修正复制语法：原代码ActiveWorkbook.Row(FoundCell.row)写法错误，正确应为工作表对象.Rows(行号).EntireRow。
• 修复粘贴目标单元格语法：Cells(c.row & ", 1")是字符串拼接错误，Cells参数需传入行号和列号两个数值，改为Cells(c.Row, 1)。
• 添加空值与未找到判断：跳过空单元格，仅在找到匹配项时执行复制，避免FoundCell为Nothing导致的运行时错误。
• 优化Find方法参数：添加LookIn:=xlValues和LookAt:=xlWhole，确保精确匹配单元格值，避免部分匹配或格式干扰。

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