VBA将一个表格拆分成多个新表格

背景：业务给了一个大表格，里面几十万条数据，要拆分成成百上千个小表格，思来想去，vba做这件事是效率最高的。

样表数据源：

请按照这个表头在excel中制作样表(最好将样表放在一个空文件夹里面)
然后调出VB编辑器，输入如下代码运行

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 '判断key是否存在
Set d(arr(i, 1)) = Union(d(arr(i, 1)), Rows(i)) '如果存在则将前面相同key的行和当前key对应的行合并成一个对象
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] '将列A每一个值对应的行单独拿出来，粘贴复制到一个新表格
.SaveAs ThisWorkbook.Path & "/" & d.keys()(ss) '每个新表格的名字是列A的每一个值
.Close
End With
Next ss
MsgBox "工作薄拆分完毕！"
End Sub


运行结果如下：

一个表格拆成7个小表格

补充第二个情景：
按照每10行做为一个表格，切分成多个表格

Sub 按A列区分内容并拆分到新表格()
Dim i%
arr = Sheets(1).[a1].CurrentRegion
For i = 2 To UBound(arr)
If i Mod 10 = 0 Then
Workbooks.Add
With ActiveWorkbook
Union(Workbooks("test.xlsx").Sheets(1).Range("a1:e1"), Workbooks("test.xlsx").Sheets(1).Range("a" & (i - 9) & ":e" & i)).Copy .Sheets(1).[a1]
.SaveAs ThisWorkbook.Path & "/" & i
.Close
End With
End If
Next i
MsgBox "工作薄拆分完毕！"
End Sub