VBA代码从Dashboard文件引用源文件数据时出现运行时错误9的问询

错误原因 #

Runtime Error 9（下标越界）出现在Worksheets(SourceSheetName).Names.Add这行，核心问题是未明确指定命名范围所属的工作簿：

• 从Dashboard文件运行代码时，当前活动工作簿是Dashboard，Worksheets(SourceSheetName)默认会在Dashboard中查找该工作表，但目标工作表属于用户选择的源文件，Dashboard中不存在，因此触发错误。
• 手动激活源文件运行时，当前活动工作簿是源文件，Worksheets(SourceSheetName)能找到对应工作表，所以可正常执行。

修复方案 #

修改代码时需明确对象的层级归属（工作簿→工作表→范围），避免依赖ActiveWorkbook这类易变对象。关键修改点如下：

1. 给Names.Add指定源文件的工作簿/工作表，确保命名范围创建在源文件内。
2. 替换依赖激活状态的Application.GoTo和Selection.Copy，改为直接操作目标范围。

修改后的完整代码 #

Sub Dashboard_Analysis()

Dim wbDashboard As Workbook
Dim myNamedRange As Range, c As Range
Dim SourceSheet As Worksheet
Dim SourceSheetName As String
Dim SearchRow As Long, StartatRow As Long, lastRow As Long
Const RangeName As String = "Dashboard_Data_Raw"
    
Set wbDashboard = ActiveWorkbook
    
Set SourceSheet = Application.InputBox("Select any cell inside the source sheet: ", _
"Prompt for selecting target sheet name", Type:=8).Worksheet
               
SourceSheetName = SourceSheet.Name

SearchRow = InputBox("Row # where Reference 'Dashboard' is entered.", "Row Input")
StartatRow = InputBox("Row # where Headers are located.", "Row Input")

lastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

'遍历指定行查找目标列
For Each c In SourceSheet.Range(SourceSheet.Cells(SearchRow, 1), _
                       SourceSheet.Cells(SearchRow, Columns.Count).End(xlToLeft)).Cells
    If LCase(c.Value) = "dashboard" Then
        '合并目标列范围
        If myNamedRange Is Nothing Then
            Set myNamedRange = SourceSheet.Range(SourceSheet.Cells(StartatRow, c.Column), SourceSheet.Cells(lastRow, c.Column))
        Else
            Set myNamedRange = Union(myNamedRange, SourceSheet.Range(SourceSheet.Cells(StartatRow, c.Column), SourceSheet.Cells(lastRow, c.Column)))
        End If
    End If
Next c

'验证并执行后续操作
If Not myNamedRange Is Nothing Then
    Debug.Print myNamedRange.Address
    Debug.Print SourceSheet.Parent.Name

    '在源文件工作簿创建命名范围
    SourceSheet.Parent.Names.Add Name:=RangeName, RefersTo:=myNamedRange

    '直接复制范围，无需激活选区
    myNamedRange.Copy

    '切换回Dashboard文件
    wbDashboard.Activate
    Debug.Print ActiveWorkbook.Name
Else
    MsgBox "指定行中未找到包含'Dashboard'的列。"
End If

End Sub

关键修改说明 #

• 用原生Union方法替代自定义BuildRange函数合并范围，避免依赖未定义的外部函数。
• 用SourceSheet.Parent.Names.Add明确在源文件的工作簿级别创建命名范围；若需工作表级命名范围，可改用SourceSheet.Names.Add。
• 添加If Not myNamedRange Is Nothing Then判断，避免未找到目标列时触发后续错误。
• 移除Application.GoTo和Selection.Copy，直接通过myNamedRange.Copy复制数据，减少对活动状态的依赖。

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