目的： 将如下成绩表根据班级分别创建工作表，表名以班级命名

代码实现：

Sub 建立新表()   '根据班级批量建立新表
Dim i As Long, sht As Worksheet
i = 3 '第一条记录是在第3行
Set sht = Worksheets("成绩表")
Do While sht.Cells(i, "B").Value <> ""
On Error Resume Next
If Worksheets(sht.Cells(i, "B").Value) Is Nothing Then  ' 判断是否已存在对应的班级工作表
Worksheets.Add after:=Worksheets(Worksheets.Count)  '在所有工作表后建立新的工作表
ActiveSheet.Name = sht.Cells(i, "B").Value
End If
i = i + 1
Loop
End Sub

结果：