如何在Excel VBA宏中实现目标工作簿动态化以导入用户选定文件数据

你的代码核心逻辑是正确的，Set TargetWbk = ThisWorkbook已经实现了动态指定运行宏的工作簿为目标工作簿。出现Subscript out of range错误，大概率是以下细节问题导致：

1. 退出分支未指定目标工作簿 #

在exitsub标签下的代码：

Worksheets("Test Import").Tab.Color = RGB(25, 25, 25)

没有明确指定工作簿，Excel会默认在当前活动工作簿（即刚打开的ReportWbk）中查找工作表，而该工作簿中不存在"Test Import"，因此触发错误。需要修改为：

TargetWbk.Worksheets("Test Import").Tab.Color = RGB(25, 25, 25)

2. 增加工作表存在性检查（可选但推荐） #

为避免因工作表名拼写错误、工作表被删除等情况引发错误，建议在复制前先验证目标工作表是否存在：

' 检查目标工作表是否存在
Dim targetWs As Worksheet
On Error Resume Next
Set targetWs = TargetWbk.Sheets("Test Import")
On Error GoTo 0
If targetWs Is Nothing Then
    MsgBox "目标工作表""Test Import""不存在于运行宏的工作簿中！", vbCritical
    GoTo exitsub
End If

' 执行复制操作
ReportWbk.Sheets(ws).Cells.Copy Destination:=targetWs.Cells(1, 1)

修正后的完整主代码 #

Private Sub GetRange()
  Dim ReportWbk As Workbook ' 包含数据的工作簿
  Dim Report As Integer ' 文件选择对话框返回值
  Dim FD As FileDialog
  Dim TargetWbk As Workbook ' 运行宏的工作簿
  Dim ws As Variant
  Dim targetWs As Worksheet ' 目标工作表

  Set TargetWbk = ThisWorkbook
  Set FD = Application.FileDialog(msoFileDialogFilePicker)
  Report = FD.Show
  
  ' 用户取消选择文件
  If Report <> -1 Then Exit Sub
  
  ' 以只读模式打开选中的工作簿，避免文件锁定
  Set ReportWbk = Workbooks.Open(FD.SelectedItems(1), ReadOnly:=True)
  
  ' 调用用户窗体选择工作表
  ws = SelectSheet.Selection(ReportWbk)
  
  ' 用户取消选择工作表
  If ws = vbCancel Then GoTo exitsub
  
  ' 检查目标工作表是否存在
  On Error Resume Next
  Set targetWs = TargetWbk.Sheets("Test Import")
  On Error GoTo 0
  If targetWs Is Nothing Then
      MsgBox "目标工作表""Test Import""不存在于运行宏的工作簿中！", vbCritical
      GoTo exitsub
  End If
  
  ' 复制数据到目标工作表
  ReportWbk.Sheets(ws).Cells.Copy Destination:=targetWs.Cells(1, 1)

exitsub:
  ' 安全关闭数据源工作簿（不保存）
  If Not ReportWbk Is Nothing Then
      ReportWbk.Close False
  End If
  
  ' 修改目标工作表标签颜色（仅当工作表存在时执行）
  If Not targetWs Is Nothing Then
      targetWs.Tab.Color = RGB(25, 25, 25)
  End If
 
End Sub

额外优化建议 #

将用户窗体的MultiSelect设置移到初始化事件中，逻辑更清晰：

Private Sub UserForm_Initialize()
    Me.Caption = "Select Sheet"
    Me.CmdOK.Caption = "OK"
    Me.cmdCancel.Caption = "Cancel"
    Me.ListBox1.MultiSelect = fmMultiSelectSingle
End Sub

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