VBA之灵活的拆分表

有这样的需求,想把工作表中的D列,按照筛选部门拆分成一个个独立的工作表,新的工作表名就是部门的名字

Sub chaifenshuju()

Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer '这个说的是一共多少行

irow = Sheet1.Range(“a65536”).End(xlUp).Row
'拆分表
For i = 2 To irow
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Range(“d” & i) Then
k = 1
End If
Next

If k = 0 Then
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Sheet1.Range("d" & i)
End If

Next
'拷贝数据

For j = 2 To Sheets.Count
Sheet1.Range(“a1:f” & irow).AutoFilter Field:=4, Criteria1:=Sheets(j).Name
Sheet1.Range(“a1:f” & irow).Copy Sheets(j).Range(“a1”)
Next

Sheet1.Range(“a1:f” & irow).AutoFilter
End Sub

1.首先要定义一个irow = Sheet1.Range(“a65536”).End(xlUp).Row
这里irow相当于最后一条数据所在的行数,因为经常要用到,所以定义成一个变量
2.从2循环到最后一行,首先初始化k=0,这样做的目的是为了防止后面的循环,k=1后,如果不改回来,就无法新建表了
然后再判断所有的工作表名是否等于我们的sheet1里面的D列名字,如果有就不新建表
如果等于0,就要新建一个表,
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Range(“d” & i)
End If
这里是在最后建
3.拷贝数据
首先从2遍历到表的数量个数
Sheet1.Range(“a1:f” & irow).AutoFilter Field:=4, Criteria1:=Sheets(j).Name
这段代码分3部分
第1部分
Sheet1.Range(“a1:f” & irow)
代表sheet1的a1到f最后全部数据里
第2部分
.AutoFilter Field:=4
这里代表从第四列筛选
第3部分
Criteria1:=Sheets(j).Name
这个代表按照sheets(j)的名字来作为筛选条件
4.清除筛选
Sheet1.Range(“a1:f” & irow).AutoFilter

这样代码就是通用的了