分类汇总（按班级，可手动设置分类项）

分类汇总VBA源代码，可手动设置分类项，并将结果按分类项（班级）新建表格。

'按班级新建表
Function NewTableByColumn()
    On Error Resume Next
    Dim tableName As String, colIndex As String '分类所在列
    Dim startRowNumber  As Integer  '开始行
    startRowNumber = 2: colIndex = "A"
    Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets(1)
    Dim rng As Range, Rang As Range '班级区域
    Set Rang = Null: Set rng = Null
    For r = startRowNumber To sh.UsedRange.Rows.Count
        tableName = sh.Cells(r, colIndex) '
        If sh.Cells(r, colIndex) = sh.Cells(r - 1, colIndex) Then '属于同一个班级
            Set rng = sh.Cells(r, colIndex).EntireRow
            Set Rang = Union(Rang, rng)
        Else '下一个班级，新建班级，新建班级之前将上一个班级的全部数据复制到对应的班级表中
            With Rang
                .Copy Destination:=ThisWorkbook.Worksheets(Worksheets.Count).[a2].Resize(.Rows.Count, .Columns.Count)
            End With
            If Not IsTableExist(tableName) Then
                addTable (tableName)
            End If
            Set Rang = Null: Set Rang = sh.Cells(r, colIndex).EntireRow
        End If
    Next r
    With Rang    '最后一个班级，复制到对应的班级表中
        .Copy Destination:=ThisWorkbook.Worksheets(Worksheets.Count).[a2].Resize(.Rows.Count, .Columns.Count)
    End With
End Function
Function addTable(tableName As String)
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets(1)
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    Dim sht As Worksheet
    Set sht = ThisWorkbook.Sheets.Item(Worksheets.Count)
    With sht
        .Name = tableName
        sh.Rows(1).Copy Destination:=.[a1].Resize(1, sh.UsedRange.Columns.Count)
    End With
End Function
Function IsTableExist(tableName As String) As Boolean
    On Error Resume Next
    If Sheets(tableName) Is Nothing Then
        IsTableExist = False
    Else
        IsTableExist = True
    End If
End Function

待分类汇总的总表：

分类汇总后新建的表：