Dim sht As Worksheet
Dim k, i As Integer
Dim irow As Integer '一共多少行
Dim l As Integer
l = InputBox("你要怎么分?")
'删除表格
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
For Each sht1 In Sheets
If sht1.Name <> "成绩表" Then
sht1.Delete
End If
Next
End If
Application.DisplayAlerts = True
irow = Sheet1.Range("a65536").End(xlUp).Row
'拆分表
For i = 2 To irow
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Cells(i, l) Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)
End If
Next
'拷贝数据
For J = 2 To Sheets.Count
Sheet1.Range("a1:h" & irow).AutoFilter Field:=l, Criteria1:=Sheets(J).Name
Sheet1.Range("a1:h" & irow).Copy Sheets(J).Range("a1")
Next
Sheet1.Range("a1:h" & irow).AutoFilter
Sheet1.Select
End Sub