下面说下在一个工作簿里把里面的一个工作表依据实际需求的条件内容，快速拆分成多个工作表方法。

1.打开excel文件，现在需要依据地区和国家这个条件，分别单独生成不同的工作表出来，最原始的方法是手动新建工作表一个一个的内容复制粘贴，这方法内容比较少是可行的，当倘若一个工作表里有几百个内容依据条件分别生成n个独立的工作表，工作效率低，不建议使用手动新建工作表复制粘贴内容；

2.右键工作表，选择查看代码打开VBA窗口，复制输入以下代码带窗口中；

Sub 工作表拆分2() '通过筛选方法完成需求，速度快，但当有合并单元格时就不能用。读者可以根据实际情况选用

Dim SplitCol As String, ColNum As Integer, HeadRows As Byte, arr, lastrow, i, ShtIndex, only As New Collection, Rng As Range

SplitCol = "D" '指定拆分条件所在列

HeadRows = 1 '指定标题行数，该区域不参与拆分

If HeadRows >= ActiveSheet.UsedRange.Rows.Count Then Exit Sub '如果指定的标题行大于已用区域行数则退出程序

ColNum = Cells(1, SplitCol).Column '将列标转换成数字

lastrow = ActiveSheet.UsedRange.Rows.Count '获取当前表已用区域的行数

arr = Range(Cells(HeadRows + 1, SplitCol), Cells(lastrow, SplitCol)).Value '将拆分列的数据赋与变量arr

On Error Resume Next

If ActiveSheet.FilterMode Then Cells.AutoFilter '如果处于筛选模式，那么去除筛选模式

For i = 1 To lastrow - HeadRows '遍历arr所有数据

'提取其中的不重复值

If Len(arr(i, 1)) > 0 Then only.Add CStr(arr(i, 1)), CStr(arr(i, 1))

Next i

ShtIndex = ActiveSheet.Index '获取当前表位置

On Error Resume Next

For i = 1 To only.Count

Debug.Print Sheets(only(i)).Name '获取与only对象中每个元素同名的工作表名（用意为判断是否存在该工作表）

If Err = 0 Then MsgBox "当前工作簿已存在与待拆分项目同名的工作表“" & only(i) & "”，暂无法拆分", 64, "友情提示": Exit Sub

Err.Clear

Next i

Application.ScreenUpdating = False '关闭屏幕更新，加快执行速度

Application.Calculation = xlCalculationManual '调为手动计算，加快执行速度

For i = 1 To only.Count '创建工作表，表的数量与表名由only对象中不重复值而定

Sheets.Add After:=Sheets(Sheets.Count) '创建

Sheets(Sheets.Count).Name = only(i) '命名

Sheets(ShtIndex).Rows("1:" & HeadRows).Copy Sheets(Sheets.Count).Cells(1, 1) '复制标题

Next i

Sheets(ShtIndex).Select '返回待拆分工作表

For i = 1 To only.Count '遍历Collection对象所有成员。Collection对象包括了所有拆分条件，即工作表名

'对拆分条件所在列进行筛选，筛选条件是Collection对象中的成员，本例中是部门名称

Range(Cells(HeadRows, SplitCol), Cells(lastrow, SplitCol)).AutoFilter Field:=1, Criteria1:=only(i)

Set Rng = Range(Cells(HeadRows + 1, SplitCol), Cells(Rows.Count, SplitCol).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow '引用筛选后的数据（整行）

With Sheets(only(i)).UsedRange.Rows(Sheets(only(i)).UsedRange.Rows.Count + 1) '引用拆分后的工作表的已用区域下一行

Rng.Copy .Cells(1) '第一次复制，复制所有数据，仅取其格式

.Cells = Rng.Value '第二次复制，仅复制数值

End With

Next

Cells.AutoFilter '去除筛选模式

Application.ScreenUpdating = True '恢复屏幕更新

Application.Calculation = xlCalculationAutomatic '恢复自动计算

MsgBox "拆分完毕！", 64, "友情提示"

End Sub

3.修改好代码之后，按下快捷键F5键运行宏命令即可快速完成工作表的拆分；

4.宏命令说明，SplitCol = "a" '指定拆分条件所在列，这里以国家地区为拆分条件，它在D列，修改为SplitCol = "D" , 而HeadRows = 1 代表指定标题行数，该区域固定不进行拆分，即拆分出来的每个工作表的首行都会有一个一样的表头,拆分之后，之后再对拆分出来的工作表进行格式修饰下，按住shift键鼠标点击多选不要的工作表右键进行删除即可。

excel一个工作表拆分多个https://www.zhihu.com/video/1247151257426538496