VBA跨工作簿复制数据并校验：活动行获取及粘贴代码故障排查

嘿，我看了你的VBA代码，发现两个核心问题：活动行的获取方式不对，还有粘贴的逻辑没法直接生效。下面是修正后的完整代码，我还加了注释帮你理解关键改动：

Sub CopyDataFromSource()
    Dim vFile As Variant
    Dim wbCopyTo As Workbook
    Dim wsCopyTo As Worksheet
    Dim wbCopyFrom As Workbook
    Dim wsCopyFrom As Worksheet
    Dim projectNumberSource As Long
    Dim projectNumberTarget As Long
    Dim targetStartCell As Range
    Dim sourceRanges As Variant
    Dim i As Integer
    
    ' 设置目标工作簿和工作表（当前激活的工作簿/工作表）
    Set wbCopyTo = ActiveWorkbook
    Set wsCopyTo = ActiveSheet
    ' 获取活动单元格作为粘贴的起始位置
    Set targetStartCell = ActiveCell
    
    ' 选择源工作簿
    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
            "*.xl*", 1, "Select Excel File", "Open", False)
    ' 如果用户取消选择，退出子程序
    If TypeName(vFile) = "Boolean" Then Exit Sub
    
    ' 打开源工作簿并指定第一个工作表
    Set wbCopyFrom = Workbooks.Open(vFile)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    
    ' --------------------------
    ' 流程编号校验逻辑
    ' --------------------------
    ' 获取源工作簿的流程编号（G5单元格）
    projectNumberSource = wsCopyFrom.Range("G5").Value
    ' 获取目标工作簿活动行的流程编号（这里假设流程编号在目标工作表的A列，你可以根据实际修改列号）
    projectNumberTarget = wsCopyTo.Cells(targetStartCell.Row, "A").Value
    
    ' 对比两个流程编号
    If projectNumberSource = projectNumberTarget Then
        MsgBox "Project number found!"
        
        ' --------------------------
        ' 复制粘贴逻辑：从活动单元格开始依次向右粘贴
        ' --------------------------
        ' 把需要复制的源单元格按顺序存入数组（方便依次粘贴）
        sourceRanges = Array("F21", "G21", "L21", "M21", "R21", "S21", _
                            "G31", "M31", "S31", "F41", "G41")
        
        ' 遍历数组，依次将源单元格的值粘贴到目标行，从起始单元格开始向右偏移
        For i = 0 To UBound(sourceRanges)
            wsCopyTo.Cells(targetStartCell.Row, targetStartCell.Column + i).Value = _
                wsCopyFrom.Range(sourceRanges(i)).Value
        Next i
        
    Else
        MsgBox "Project Number Does Not Match!"
    End If
    
    ' 关闭源工作簿，不保存修改
    wbCopyFrom.Close SaveChanges:=False
End Sub

关键改动说明 #

1. 修复活动行获取问题 #

• 原来的Set rng = wsCopyTo.Cells.EntireRow.Select是错误写法，现在直接用ActiveCell.Row获取活动单元格所在行，同时用ActiveCell记录粘贴起始位置，避免混淆。
• 流程编号校验不再遍历整行，而是直接取目标活动行的指定列（代码里假设是A列，你可以根据实际需求修改列号，比如改成"B"或者数字2），和源工作簿的G5值对比，更高效。

2. 实现正确的粘贴逻辑 #

• 把需要复制的源单元格地址按顺序存入数组sourceRanges，循环遍历数组时，用targetStartCell.Column + i实现向右偏移粘贴，完全符合“从活动单元格开始依次向右”的需求。
• 直接用单元格赋值（Value = Value）代替Copy/PasteSpecial，不仅运行速度更快，还不会影响剪贴板内容。

3. 修正语法错误 #

• 修复了原代码中wsCopyFrom.Range("G5).Value缺失右引号的问题。
• 完善了条件判断语句的语法（原代码If c.Value = projectNumber缺少Then）。
• 统一了变量命名，让代码更易读。

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