VBA跨工作簿复制粘贴失效求助：非激活方式无法执行

我要实现的功能很简单：从一个工作簿的指定区域复制数据到另一个工作簿。但运行下面的代码时，复制操作完全没执行（复制逻辑在Sub最后部分）。我怀疑是Worksheet/Workbook的引用出了问题，但作为VBA新手找不到具体原因。

Function getHeaderRange(searched As String, ws As Worksheet) As Range
    Dim colNum
    Dim cellLength
    colNum = WorksheetFunction.Match(searched, ws.Range("5:5"))
    cellLength = ws.Range(ws.Cells(5, colNum), ws.Cells(5, colNum)).MergeArea.Count
    Set getHeaderRange = Range(ws.Cells(6, colNum), ws.Cells(6, colNum + cellLength - 1))
End Function

Function getDataRange(searched As String, hRange As Range) As Range
    Dim column: column = WorksheetFunction.Match(searched, hRange) + hRange.column - 1
    Set getDataRange = Range(Cells(6, column), Cells(6, column))
    Debug.Print (hRange.Worksheet.Parent.Name & "Sheet: " & hRange.Worksheet.Name)
    Set getDataRange = getDataRange.Offset(1, 0)
    Set getDataRange = getDataRange.Resize(8)
    
End Function

Sub main()
    Dim srcWs As Worksheet: Set srcWs = Workbooks("Period end open receivables, step 5").Sheets(1)
    Dim trgWs As Worksheet: Set trgWs = ThisWorkbook.Sheets("Obiee")
    
    Dim searched As String
    Dim hSearched As String
    searched = "Magazines, Merchants & Office"
    
    Dim srcRange As Range: Set srcRange = getHeaderRange(searched, srcWs)
    Dim trgRange As Range: Set trgRange = getHeaderRange(searched, trgWs)
    
    Dim cocd() As Variant
    Dim i As Integer
    cocd = getHeaderRange("Magazines, Merchants & Office", trgWs)
    For i = 1 To UBound(cocd, 2)
        hSearched = cocd(1, i)
        getDataRange(hSearched, srcRange).Copy
        getDataRange(hSearched, trgRange).PasteSpecial xlPasteValues
    Next i
End Sub

把最后几行改成下面的代码后功能正常，但我不想用激活工作表的方式，求排查初始代码的问题：

For i = 1 To UBound(cocd, 2)
        hSearched = cocd(1, i)
        srcWs.Activate
        getDataRange(hSearched, srcRange).Copy
        trgWs.Activate
        getDataRange(hSearched, trgRange).Select
        ActiveSheet.Paste
    Next i

补充：源工作簿和目标工作簿的表格结构一致：

• 源工作簿：包含"Magazines, Merchants & Office"合并表头的表格区域
• 目标工作簿：与源工作簿结构完全匹配的对应区域

问题原因分析 #

核心问题是所有Range、Cells对象未明确指定父工作表。VBA中如果不声明父对象，会自动引用当前激活的工作表，导致你获取的Range不是预期的源/目标工作表中的区域，复制粘贴操作自然无法生效。

具体修正点 #

1. getHeaderRange函数：
   原代码中Set getHeaderRange = Range(...)未指定父工作表，需改为ws.Range(...)，绑定传入的目标工作表：

   Set getHeaderRange = ws.Range(ws.Cells(6, colNum), ws.Cells(6, colNum + cellLength - 1))
   

2. getDataRange函数：
   原代码中Range(Cells(...))既没指定父工作表，需先获取hRange所属的工作表，再绑定所有Range、Cells对象：

   Dim targetWs As Worksheet
   Set targetWs = hRange.Worksheet
   Set getDataRange = targetWs.Range(targetWs.Cells(6, column), targetWs.Cells(6, column))
   

修正后的完整代码 #

Function getHeaderRange(searched As String, ws As Worksheet) As Range
    Dim colNum
    Dim cellLength
    colNum = WorksheetFunction.Match(searched, ws.Range("5:5"))
    cellLength = ws.Range(ws.Cells(5, colNum), ws.Cells(5, colNum)).MergeArea.Count
    ' 明确绑定父工作表ws
    Set getHeaderRange = ws.Range(ws.Cells(6, colNum), ws.Cells(6, colNum + cellLength - 1))
End Function

Function getDataRange(searched As String, hRange As Range) As Range
    Dim column
    Dim targetWs As Worksheet
    ' 获取hRange所属的工作表，统一绑定后续所有Range/Cells
    Set targetWs = hRange.Worksheet
    column = WorksheetFunction.Match(searched, hRange) + hRange.Column - 1
    Set getDataRange = targetWs.Range(targetWs.Cells(6, column), targetWs.Cells(6, column))
    Debug.Print (targetWs.Parent.Name & "Sheet: " & targetWs.Name)
    Set getDataRange = getDataRange.Offset(1, 0)
    Set getDataRange = getDataRange.Resize(8)
End Function

Sub main()
    Dim srcWs As Worksheet: Set srcWs = Workbooks("Period end open receivables, step 5").Sheets(1)
    Dim trgWs As Worksheet: Set trgWs = ThisWorkbook.Sheets("Obiee")
    
    Dim searched As String
    Dim hSearched As String
    searched = "Magazines, Merchants & Office"
    
    Dim srcRange As Range: Set srcRange = getHeaderRange(searched, srcWs)
    Dim trgRange As Range: Set trgRange = getHeaderRange(searched, trgWs)
    
    Dim cocd() As Variant
    Dim i As Integer
    cocd = getHeaderRange("Magazines, Merchants & Office", trgWs)
    For i = 1 To UBound(cocd, 2)
        hSearched = cocd(1, i)
        getDataRange(hSearched, srcRange).Copy
        getDataRange(hSearched, trgRange).PasteSpecial xlPasteValues
    Next i
End Sub

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