1.将数据根据部门分类，分发到相应表中
除了第一张表有数值，其他表均为空
将数据分类代码如下：
Sub copy()
'根据表名筛选相应数据拷贝到相应表中'
Dim i, j As Integer
j = Sheet1.Range("a65535").End(xlUp).Row ‘j为表1中最后一个数值，a65536为xls最后一个单元格，end(xlup)到最后一个有数值的单元格，所以j表示表1最后一行
For i = 2 To Sheets.Count
Sheet1.Range("$A$1:$F$" & j).AutoFilter Field:=4, Criteria1:=Sheets(i).Name ‘根据表名筛选
Sheet1.Range("$A$1:$F$" & j).Copy Sheets(i).Range("a1") ‘将筛选的数值拷贝到相应的表中
Next
End Sub
执行后结果
2.现在想根据指定的列分类，分类后的数据进行创建表。
根据输入的列分表相应代码如下：
Sub xinjianbiao()
Dim sht As Worksheet
Dim k，l As Integer
l=input("输入分类的列") ‘需要将l进行定义，否则l是字符
For i = 1 To Sheets(1).Range("a65536").End(xlUp).Row
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.cells(i,l) Then '用cells表示单元格，可以使用数字变量代表列
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
end sub
3.现在想根据指定的列分类，分类后的数据进行创建表，并根据分类的数据拷贝到相应表中
完整流程展示
数据都根据第4列的值进行分类，根据分类创建了表并将相应的值放到相应的表中
一下展示完整的代码：
Sub delete() ‘重新分类时需将之前的创建的表进行删除，不然表会越堆积越多
Dim i As Integer
Application.DisplayAlerts = False
For i = Sheets.Count To 2 Step -1
Sheets(i).delete
Next
Application.DisplayAlerts = True
End Sub
-------------------------
Sub 根据分类创建表()
Call delete ‘调用上面的delete函数
Dim sht As Worksheet
Dim k, j,h As Integer
j = Sheet1.Range("a65535").End(xlUp).Row
h = InputBox("输入需要分类的列")
For i = 1 To j
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Cells(i, h) Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(i, h)
End If
Next
'根据分类拷贝到各个表中'
For i = 2 To Sheets.Count
Sheet1.Range("$A$1:$F$" & j).AutoFilter Field:=h, Criteria1:=Sheets(i).Name
Sheet1.Range("$A$1:$F$" & j).copy Sheets(i).Range("a1")
Next
End Sub
