VBA按工作表名匹配复制数据报错：工作表超出范围

错误原因分析 #

• 未限定Cells的工作表引用：原代码中spl = Cells(i, "A").Value没有指定来源工作表，默认会读取当前活动工作表的单元格值，而非SETTING表的A列内容，导致spl取值错误，自然找不到对应工作表。
• 工作表名称不匹配：SETTING表A列的项目类型值与实际工作表名称存在差异，比如包含前后空格、特殊字符，或者根本不存在对应名称的工作表。
• 未初始化变量offsetRow：原代码中offsetRow未赋值，当auxRow = 1时会调用未定义的值，后续也会引发错误。

修正后的完整代码 #

Sub Copy_Data()
    Dim lastrow1 As Long, i As Long, auxRow As Long, offsetRow As Long
    Dim spl As String
    Dim ws As Worksheet, supplier As Worksheet
    
    ' 明确指定目标数据源工作表
    Set ws = ThisWorkbook.Sheets("SETTING")
    lastrow1 = ws.Columns("A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    ' 初始化写入起始行（根据实际表头位置调整，示例为第2行）
    offsetRow = 2
    
    For i = 7 To lastrow1
        ' 读取SETTING表A列值并去除前后空格，避免名称匹配误差
        spl = Trim(ws.Cells(i, "A").Value)
        
        ' 检查目标工作表是否存在
        On Error Resume Next
        Set supplier = ThisWorkbook.Sheets(spl)
        On Error GoTo 0
        
        ' 仅当工作表存在时执行写入操作
        If Not supplier Is Nothing Then
            ' 获取目标工作表A列最后一行行号
            auxRow = supplier.Columns("A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            
            ' 确定写入的起始行
            auxRow = IIf(auxRow > 1, auxRow + 1, offsetRow)
            
            ' 写入匹配数据
            supplier.Cells(auxRow, "A") = ws.Cells(i, "A").Value
            supplier.Cells(auxRow, "B") = ws.Cells(i, "D").Value
            
            ' 重置变量，避免循环中出现引用混乱
            Set supplier = Nothing
        Else
            ' 可选：提示不存在对应工作表，方便排查
            MsgBox "工作表 '" & spl & "' 不存在，跳过该行数据", vbExclamation
        End If
    Next i
End Sub

关键修正点说明 #

1. 强制限定工作表引用：所有单元格操作都加上ws.前缀，确保读取的是SETTING表的正确数据。
2. 处理空格干扰：用Trim()函数清除单元格值的前后空格，解决因空格导致的名称匹配失败问题。
3. 添加存在性检查：通过错误捕获机制判断目标工作表是否存在，避免直接触发“超出范围”错误。
4. 初始化变量：给offsetRow赋值，避免使用未定义变量引发的逻辑错误。

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