在各行各业的日常工作中，经常需要把一份工作表的内容归类拆分到N个工作簿，最基础的办法就是通过筛选、排序归类数据，然后复制原数据，再新建工作簿，粘贴数据，如此往复......如果数量较小，这样操作没问题，如果分类的数据非常多，要新建几百，几千个工作簿，那就是一个非常大的工作量了。

此时就需要使用批量处理的方法，可以用PQ，也可以用VBA，本文就分享用VBA来处理批量拆分工作簿，用VBA的好处在于，只要代码写好，不需要懂代码，任何人都可以直接拿来用，其他办法就需要对软件操作有一些要求了。

以下图这个表格为例：

工作场景：这是一位学员给我提出的问题，她说这个表格每个星期要做一次，需要把这个表格按A列的店铺名称归类到一起然后拆分到工作簿，A列中有几个店就要拆分成几个工作簿，并且还要保留原来的批注图片，拆分出来的工作簿名称以店铺名称命名。

这个问题的关键点：

1、A列的店铺是无序的

2、保留表格中的批注图片

3、工作簿命名为对应的店铺名称

OK，问题描述清楚了，那就开始讲解VBA操作步骤。

VBA操作步骤

1、首先表格需要打开宏设置，点击文件——Excel选项——信任中心——信任中心设置——宏设置——启用所有宏，然后点击确定。

这个步骤，每台电脑只要设置过一次，以后都默认开启，如果你以前用过VBA那这个步骤可以略过。

2、鼠标放在原数据所在的工作表，点击鼠标右键，查看代码，进入VBA编辑界面

将代码复制到上图所示的区域中。

复制下面的代码↓↓↓↓↓↓（黑色加粗部分）

Sub 按A列区分内容并拆分到工作薄()

Dim i%

arr = Sheets(1).[a1].CurrentRegion

Set d = CreateObject("scripting.dictionary")

For i = 2 To UBound(arr)

If d.exists(arr(i, 1)) Then

Set d(arr(i, 1)) = Union(d(arr(i, 1)), Rows(i))

Else

Set d(arr(i, 1)) = Union(Rows(1), Rows(i))

End If

Next i

For ss = 0 To d.Count - 1

Workbooks.Add

With ActiveWorkbook

d.items()(ss).Copy .Sheets(1).[a1]

.SaveAs ThisWorkbook.Path & "/" & d.keys()(ss)

.Close

End With

Next ss

MsgBox "快学Excel提示您，工作薄拆分完毕！"

End Sub

3、点击运行(点击绿色三角形)，代码运行时，屏幕会闪烁，拆分出来的新工作簿会放在原工作簿的路径里。如果原工作簿放在一个文件夹，那新拆分出来的工作簿也会在这个文件夹里，如果原工作簿放在桌面，那拆分出来的工作簿就会放在桌面上。当拆分完毕时，会弹出提示框，表明代码运行完毕。

拆分完毕后，新工作薄以店铺名称命名

拆分完后随意打开一张看一下，店铺名称已经归类拆分好了，并且批注图片保留下来了。

如何根据自己的需求修改代码？

上面的案例所用的代码默认表格的格式为：表头一行，拆分依据为A列

1、如果我的表头是一行，但是我以B列为依据拆分应该如何对代码进行调整呢？

把代码的这4处（下图中红框标记处）修改为2

如果以C列为拆分依据就修改成3，以此类推。

2、如果我的表头是多行并且表头有合并单元格怎么改代码？

如下图所示，表头是2行，并且有合并单元格，以B列为拆分依据

表头有合并单元对代码运行没有任何影响，无需针对这个修改代码。

表头如果是两行需要对代码，上面红框处把2修改成3，下面红框处rows(1)修改成rows("1:2")

如果表头是3行，上面红框就修改成4，下面红框处就修改成rows("1:3") 以此类推。

好了关于如何用VBA拆分工作簿就分享到这里，如果这篇文章能帮助到你请点赞，收藏，你的点赞是我继续创作的动力。

本文由快学excel原创，欢迎大家关注。