拆分工作簿为多个文件_【VBA】按部门快速拆分工作簿

诸君好，今天我们继续分享VBA常用小代码，按指定的字段将数据拆分为多个工作簿。

举个栗子，如上图所示的数据表，倘若需要按班级，将该表的数据拆分为1~2~3班三个工作簿，并保留在电脑的指定位置，就可以使用我们今天这篇小代码了。

操作动画演示：

动画中所粘贴的代码如下：

Sub NewWorkBooks()

Dim d As Object, arr, brr, r, kr, i&, j&, k&, x&, Mystr$

Dim Rng As Range, Rg As Range, tRow&, tCol&, aCol&, pd&, mypath$

Dim Cll As Range, sht As Worksheet

' '

'第一部分，用户选择保存分表工作簿的路径。

With Application.FileDialog(msoFileDialogFolderPicker)

'选择保存工作薄的文件路径

.AllowMultiSelect = False

'不允许多选

If .Show Then

mypath = .SelectedItems(1)

'读取选择的文件路径

Else

Exit Sub

'如果没有选择保存路径，则退出程序

End If

End With

If Right(mypath, 1) <> "" Then mypath = mypath & ""

' '

'第二部分遍历总表数据，通过字典将指定字段的不同明细行过滤保存

Set d = CreateObject("scripting.dictionary") 'set字典

Set Rg = Application.InputBox("请框选拆分依据列！只能选择单列单元格区域！