版权声明：本文为博主原创文章，未经博主允许不得转载。 https://blog.csdn.net/kese7952/article/details/80331851
课件下载 ：
方式1：本节课件下载地址：链接: https://pan.baidu.com/s/1rf5pRmZ95fjVbz70KYi6Aw 密码: q9yk
方式2：或点击此处下载
效果预览图：
示例代码：
Sub 根据部门创建表并且完成数据拆分最终版()
Dim sht As Worksheet '定义变量 sht作为一个工作表对象
Dim i, k, j As Integer '定义变量 i,k,j 作为一个整数类型对象
Dim m As Integer '定义变量 m 作为一个整数类型对象 表示 客户端输入的拆分列数
Dim irow As Integer '定义变量 irow 作为一个整数类型对象 代表的是有效数据的最后一行
irow = Sheet1.Range("a65536").End(xlUp).Row
'删除
Application.DisplayAlerts = False '不显示删除警告框
For Each sht In Sheets '表对象 sht 在 表集合(sheets)中进行循环
If sht.Name <> "数据" Then '如果表的名字 不等于 数据 那么
sht.Delete ' 表执行删除操作
End If '结束如果语句
Next ' 结束循环语句
m = InputBox("请输入你要按哪列进行拆分") 'input代表输入 ， box为盒子； inputbox 表示：输入框 m 代表接收 客户端输入的整数类型
'根据部门建表
For i = 2 To irow ' i 代表整数 从2到有效数据的最后进行循环
k = 0 ' k 代表一个标记 初始化时，就为0，该标记作为后面判断的条件
For Each sht In Sheets '表对象 sht 在 表集合(sheets)中进行循环
If sht.Name = Sheet1.Cells(i, m) Then '如果表的名字 等于 第一个表的单元格(行，列) 那么
k = 1 ' 将 标记变量 k 设置为一个数字 例如：1
End If '结束如果语句
Next ' 结束循环语句
If k = 0 Then '如果标记的变量 k = 0 那么 执行下列代表 但是如果不等于 则不执行
Sheets.Add after:=Sheets(Sheets.Count) '在最后一张表后执行添加表 操作
Sheets(Sheets.Count).Name = Sheet1.Cells(i, m) ' 添加后的表的名字wie 第一个表的单元格(行，列)
End If '结束如果语句
Next ' 结束循环语句
'拷贝数据 ：j 代表的是表的序号
For j = 2 To Sheets.Count
' 第一个表的单元格区域为 a1 到 f 有效数据最后一行 执行筛选 筛选列为 输入的列m 条件是 表的名字(指定列名相同)
Sheet1.Range("a1：f" & irow).AutoFilter Field:=m, Criteria1:=Sheets(j).Name
' 第一个表的单元格区域为 a1 到 f 有效数据最后一行执行拷贝 到 循环到的某张表的a1单元格
Sheet1.Range("a1：f" & irow).Copy Sheets(j).Range("a1")
' 第一个表的单元格区域为 a1 到 f 有效数据最后一行 执行筛选(取消筛选操作)
Sheet1.Range("a1：f" & irow).AutoFilter
Next ' 结束循环语句
End Sub
作者： 杨校
出处： https://blog.csdn.net/kese7952
分享是快乐的，也见证了个人成长历程，文章大多都是工作经验总结以及平时学习积累，基于自身认知不足之处在所难免，也请大家指正，共同进步。
本文版权归作者所有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出, 如有问题， 可邮件（397583050@qq.com）咨询。
