Sub SplitWorkbookBySchoolAndClass()     Dim dataSheet As Worksheet     Dim outputSheet As Worksheet     Dim currentRow As Long     Dim lastRow As Long     Dim startRFow As Long     Dim school As String     Dim class1 As String     Dim filePath As String     Dim fileDirectory As String     Dim previousSchool As String     Dim previousClass As String          ' 设置数据源工作表名称     Set dataSheet = ThisWorkbook.Sheets("Sheet1") ' 更改为你的数据源工作表名称

    ' 获取数据源的最后一行     lastRow = dataSheet.Cells(dataSheet.Rows.Count, "A").End(xlUp).Row

    ' 初始化学校和班级变量     previousSchool = ""     previousClass = ""     ' 下一次开始的行数     startRFow =  2     ' 设置生成文档目录     fileDirectory = "C:\Users\CGF\Desktop\新建文件夹\"     ' 遍历数据源中的每一行     For currentRow = 2 To lastRow         ' 获取当前行的学校和班级         school = dataSheet.Range("A" & currentRow).Value         class1 = dataSheet.Range("B" & currentRow).Value                  ' 如果学校或班级发生变化，并且之前已经有学校和班级记录，则创建新的工作簿并保存         If (school previousSchool Or class1 previousClass) And (previousSchool "" And previousClass "") Then             ' 设置文件路径和名称             filePath = fileDirectory & previousSchool & "-" & previousClass & ".xlsx" ' 更改为你的输出文件夹路径

            ' 创建新的工作簿             Set outputSheet = Workbooks.Add(xlWBATWorksheet).Sheets("Sheet1")

            ' 复制当前班级的数据到新工作簿（包括标题行）             dataSheet.Range("A1:C1").Copy outputSheet.Range("A1")             dataSheet.Range("A" & startRFow & ":C" & currentRow - 1).Copy outputSheet.Range("A2")             startRFow = currentRow             ' 保存新工作簿并关闭             Application.DisplayAlerts = False             outputSheet.Parent.SaveAs Filename:=filePath             outputSheet.Parent.Close SaveChanges:=False             Application.DisplayAlerts = True         End If

        ' 更新学校和班级变量         previousSchool = school         previousClass = class1     Next currentRow

    ' 处理最后一组学校和班级数据     If previousSchool "" And previousClass "" Then         ' 设置文件路径和名称         filePath = fileDirectory & previousSchool & "-" & previousClass & ".xlsx" ' 更改为你的输出文件夹路径

        ' 创建新的工作簿         Set outputSheet = Workbooks.Add(xlWBATWorksheet).Sheets("Sheet1")

        ' 复制当前班级的数据到新工作簿（包括标题行）         dataSheet.Range("A1:C1").Copy outputSheet.Range("A1")         dataSheet.Range("A" & startRFow & ":C" & currentRow - 1).Copy outputSheet.Range("A2")

        ' 保存新工作簿并关闭         Application.DisplayAlerts = False         outputSheet.Parent.SaveAs Filename:=filePath         outputSheet.Parent.Close SaveChanges:=False         Application.DisplayAlerts = True     End If

    MsgBox "拆分完成!" End Sub