【Excel技巧】保留表头拆分数据为若干新工作簿

工作中往往需要把一个表格中数据按照某一列进行分类，然后以此分别保存为单独的excel工作簿，下面这段代码就是实现此功能的，收藏保留！
打开excel表格，按alt+F11，打开vbs，“插入”→“类”→把下面的代码插入右边区域，保存，或者直接运行即可，保存后在“宏”中打开运行。
Sub 保留表头拆分数据为若干新工作簿()
Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
c = Application.InputBox('请输入拆分列号', , 4, , , , , 1)
If c = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
arr = [a3].CurrentRegion
lc = UBound(arr, 2)
Set rng = [a1].Resize(, lc)
Set d = CreateObject('scripting.dictionary')
For i = 2 To UBound(arr)
If Not d.Exists(arr(i, c)) Then
Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc)