Excel按条件拆分工作表：VBA代码缺失B列数据及范围扩展需求

原代码存在两个核心问题导致B列数据缺失：一是仅从E列开始提取数据，完全遗漏了B-D列；二是写入新表时从E10开始，即便包含B列也不会显示。以下是修改后的代码，既保留E列作为拆分条件，又覆盖B到AD列的完整数据范围：

Sub Split_Sheet()
    Application.ScreenUpdating = False
    Dim sArr(), i As Long, sMachine(), j As Long, k As Long, dArr(), n As Long
    Dim lastRow As Long
    
    With Sheets("PFL_PRINT")
        ' 获取B列到AD列的有效数据范围（从B10开始到最后一行）
        lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
        sArr = .Range("B10:AD" & lastRow).Value
    End With
    
    ' 用E列（对应sArr的第4列，因为B是第1列）作为拆分条件去重
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(sArr)
            If Not .Exists(sArr(i, 4)) Then .Add sArr(i, 4), ""
        Next
        sMachine = .keys
    End With
    
    For n = 0 To UBound(sMachine)
        ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
        k = 0
        For i = 1 To UBound(sArr)
            ' 匹配E列对应的数据项
            If sArr(i, 4) = sMachine(n) Then
                k = k + 1
                For j = 1 To UBound(sArr, 2)
                    dArr(k, j) = sArr(i, j)
                Next
            End If
        Next
        With Sheets.Add
            .Name = sMachine(n)
            ' 从B10开始写入完整数据，确保B列显示
            .Range("B10").Resize(k, UBound(dArr, 2)) = dArr
        End With
    Next
    Application.ScreenUpdating = True
End Sub

关键修改说明： #

• 数据读取范围调整：直接指定B10:AD的完整列范围，通过lastRow获取有效数据的最后一行，避免固定列数导致的范围错误
• 拆分条件索引修正：原表E列对应数组的第4列（B=1、C=2、D=3、E=4），所以字典去重和匹配时都用sArr(i,4)
• 写入起始位置修正：新表从B10开始写入数据，确保B列数据能直接展示在对应位置

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