VBA跨工作表复制数据至新工作簿时出现脚本越界错误求助

首先纠正下，你遇到的应该是Subscript out of range错误（大概率是输入时的笔误），这个错误的核心原因是：你尝试激活的Windows(sfilename1)对应的工作簿对象不存在——可能是Sheet2处理时文件名生成逻辑有问题，或者之前创建的工作簿被意外关闭，更关键的是，依赖Activate/Select这种操作窗口的方式本身就很不稳定，很容易因为窗口状态变化出问题。

下面给你一套更可靠的实现方案，完全避免使用Activate/Select，同时兼容Sheet1和Sheet2不同的数据范围：

核心思路 #

1. 用对象变量直接引用工作簿、工作表、数据范围，彻底摆脱对窗口激活的依赖
2. 封装通用的拆分逻辑，让Sheet1和Sheet2可以复用同一套代码，只需要传入各自的数据范围
3. 处理每个State时，先检查对应的工作簿是否已存在，避免重复创建或找不到对象

完整示例代码 #

Sub SplitDataByState()
    Dim mainWB As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim savePath As String
    
    ' 设置主工作簿和工作表
    Set mainWB = ThisWorkbook
    Set ws1 = mainWB.Sheets("Sheet1")
    Set ws2 = mainWB.Sheets("Sheet2")
    
    ' 设置保存路径（改成你自己的目标文件夹，注意末尾要加反斜杠）
    savePath = "C:\YourTargetFolder\"
    
    ' 处理Sheet1：假设State列在第3列，数据起始于A1（可根据实际修改）
    ProcessWorksheet ws1, savePath, 3, "A1"
    
    ' 处理Sheet2：假设State列在第5列，数据起始于B2（可根据实际修改）
    ProcessWorksheet ws2, savePath, 5, "B2"
    
    MsgBox "数据拆分完成！", vbInformation
End Sub

' 通用处理子过程：适配任意带State列的工作表
Sub ProcessWorksheet(ws As Worksheet, savePath As String, stateCol As Integer, startCell As String)
    Dim lastRow As Long, i As Long
    Dim targetWB As Workbook
    Dim targetWS As Worksheet
    Dim stateName As String
    
    ' 获取当前工作表的最后一行数据
    lastRow = ws.Cells(ws.Rows.Count, stateCol).End(xlUp).Row
    
    ' 遍历每一行数据（跳过表头）
    For i = ws.Range(startCell).Row + 1 To lastRow
        stateName = Trim(ws.Cells(i, stateCol).Value)
        If stateName <> "" Then
            ' 检查对应State的工作簿是否已存在
            On Error Resume Next
            Set targetWB = Workbooks(stateName & ".xlsx")
            On Error GoTo 0
            
            ' 不存在则创建新工作簿
            If targetWB Is Nothing Then
                Set targetWB = Workbooks.Add
                targetWB.SaveAs Filename:=savePath & stateName & ".xlsx"
                Set targetWS = targetWB.Sheets(1)
                ' 复制表头到目标工作表
                ws.Range(startCell).Resize(1, ws.UsedRange.Columns.Count).Copy targetWS.Range("A1")
            Else
                ' 已存在则直接获取工作表
                Set targetWS = targetWB.Sheets(1)
            End If
            
            ' 复制当前行数据到目标工作表的最后一行
            ws.Rows(i).Copy targetWS.Cells(targetWS.Rows.Count, 1).End(xlUp).Offset(1, 0)
            
            ' 保存并释放对象
            targetWB.Save
            Set targetWB = Nothing
            Set targetWS = Nothing
        End If
    Next i
End Sub

关键改进点解释 #

1. 抛弃Activate/Select：全程用对象变量直接操作，完全不依赖窗口状态，从根源上解决“找不到窗口”的错误
2. 通用化处理：ProcessWorksheet子过程可以适配任意工作表，只需要传入几个关键参数，完美兼容Sheet1和Sheet2的不同数据范围
3. 存在性校验：每次处理State时先检查对应的工作簿是否已打开，避免重复创建或引用不存在的对象
4. 清晰的路径管理：明确指定保存路径，确保文件能正确存储到目标位置，减少找不到文件的概率

你需要调整的地方 #

• 修改savePath为你实际要保存文件的文件夹路径
• 针对Sheet1和Sheet2，调整ProcessWorksheet调用中的State列号和数据起始单元格（比如Sheet1的State在第2列就传2，起始单元格是A2就传"A2"）

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