从其他应用调用Excel宏时Range.copy方法失效问题求助

问题根因 #

• 未限定Range对象归属：Set rngNumber = Range(.Cells(2), .Cells(.Rows.Count).End(xlUp)) 这行的Range没有加工作表前缀ws.，跨应用调用时，无归属的Range会默认指向调用端上下文，而非你启动的Excel实例里的工作表，导致实际取到的是空范围，复制自然无效果，本地运行时默认是当前Excel实例所以没问题。
• Find_Column函数参数缺失：函数内部使用的ws没有作为参数传入，跨进程调用时变量作用域异常，很可能找不到对应的工作表，导致返回的列号错误，甚至直接出错被On Error Resume Next吞掉。
• 错误捕获逻辑滥用：多处On Error Resume Next把所有报错都吞了，你完全看不到实际的错误信息，没法定位问题。
• 多余的Activate操作：跨应用调用时，Activate操作很容易因为窗口焦点问题失效，完全没必要用，所有对象直接通过变量引用即可。
• 变量重复声明：代码里先后两次声明和赋值wb，属于冗余逻辑，也可能导致变量赋值异常。

修正后的代码 #

Sub TEST()
    Dim excelApp As Excel.Application
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    If Err Then
        Err.Clear
        Set excelApp = CreateObject("Excel.Application")
        If Err Then
            MsgBox "无法启动Excel"
            Exit Sub
        End If
    End If
    On Error GoTo 0 ' 恢复错误捕获，不要吞错
    excelApp.Visible = True

    ' 选择要打开的文件
    Dim ExcelFilePath As Variant
    ExcelFilePath = excelApp.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If ExcelFilePath = False Then Exit Sub ' 点取消直接退出
    
    Dim wb As Workbook
    Set wb = excelApp.Workbooks.Open(ExcelFilePath)
    Dim ws As Worksheet
    Set ws = wb.Worksheets(1)
    Dim wsData As Worksheet
    Set wsData = wb.Worksheets(2)
    
    ' 写入表头
    wsData.Cells(1, "A").Value = "Number"
    
    ' 获取Number所在列，把ws作为参数传入函数
    Dim sNumber As String
    sNumber = Find_Column(ws, "Number")
    If sNumber = "" Then
        MsgBox "未找到Number列"
        Exit Sub
    End If
    
    ' 正确限定Range的归属为ws
    Dim rngNumber As Range
    With ws.Columns(sNumber)
        Set rngNumber = ws.Range(.Cells(2), .Cells(.Rows.Count).End(xlUp))
    End With
    
    ' 确保rngNumber有数据再复制
    If Not rngNumber Is Nothing And rngNumber.Row >= 2 Then
        rngNumber.Copy wsData.Range("A2")
    Else
        MsgBox "Number列无有效数据可复制"
    End If
End Sub

' 新增ws参数，明确指定要查找的工作表
Private Function Find_Column(ws As Worksheet, Name As String) As String
    Dim rngName As Range
    On Error Resume Next
    Set rngName = ws.Rows(1).Find(Name, , xlValues, xlWhole)
    On Error GoTo 0
    If Not rngName Is Nothing Then
        Find_Column = Split(rngName.Address, "$")(1)
    Else
        Find_Column = ""
    End If
End Function

额外注意事项 #

• 跨应用调用时所有Excel对象（Workbook、Worksheet、Range等）都必须明确绑定到你创建的excelApp实例下，不要使用无归属的对象调用
• 调试时可以临时去掉所有On Error Resume Next，方便看到具体报错信息
• 如果调用端不是VBA环境（比如C#、Python等），注意要释放所有Excel COM对象，避免Excel进程残留

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