Excel如何通过FullPath从另一已关闭Excel文件中获取数据

你的原有代码已经实现了文件选择逻辑，仅需补充文件打开、数据复制的逻辑即可，以下是优化了过滤规则、错误处理后的完整可运行代码：

Private Sub PathName()
    Dim FullPath As Variant ' 此处修改为Variant类型，适配用户点取消时返回的布尔值False
    Dim sourceWB As Workbook
    Dim targetWS As Worksheet
    
    ' 关闭屏幕更新和告警，提升运行速度、避免多余弹窗
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error GoTo extApp
    ' 优化文件过滤器，仅保留Excel可读取的格式，避免选中非Excel文件引发报错
    FullPath = Application.GetOpenFilename(FileFilter:="Excel文件," & _
    "*.xls;*.xlsx;*.xlsm;*.xlsb", Title:="请选择要复制数据的Excel文件")
    
    ' 判断用户是否点击了取消，未选择文件时直接退出
    If FullPath = False Then
        GoTo cleanUp
    End If
    
    ' 只读模式打开选中的源工作簿
    Set sourceWB = Workbooks.Open(FullPath, ReadOnly:=True)
    ' 设置当前宏文件的目标粘贴工作表，可按需修改工作表名称
    Set targetWS = ThisWorkbook.Sheets("Sheet1")
    
    ' 复制源工作簿第一个工作表的全部已使用区域到目标位置
    ' 如果不需要复制格式、仅需要粘贴数值，注释掉下面一行，启用后面两行注释的代码即可
    sourceWB.Sheets(1).UsedRange.Copy Destination:=targetWS.Range("A1")
    ' sourceWB.Sheets(1).UsedRange.Copy
    ' targetWS.Range("A1").PasteSpecial Paste:=xlPasteValues
    
    ' 关闭源工作簿，不保存修改
    sourceWB.Close SaveChanges:=False

cleanUp:
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub
    
extApp: 
    Select Case Err.Number
        Case 104
            MsgBox ("104")
        Case Else
            MsgBox "运行错误:  " & Err.Number & vbNewLine & Err.Description
    End Select
    ' 出错时也恢复Excel默认设置
    GoTo cleanUp
End Sub

注意事项 #

• 代码默认复制源文件第一个工作表的全部已使用内容，你可以将sourceWB.Sheets(1)修改为指定工作表，比如sourceWB.Sheets("数据汇总")
• 粘贴位置默认是当前文件Sheet1工作表的A1单元格，可按需修改targetWS.Range("A1")调整粘贴起始位置
• 如果源文件存在合并单元格、隐藏行列等特殊格式，可根据需求调整复制的区域范围

内容的提问来源于stack exchange，提问作者Göktuğ Ozleyen