Excel：总表拆分为工作表——VBA流
1、步骤1：按ALT+F11组合键，打开VBE界面；
2、步骤2：在左边工程窗口处，单击鼠标右键，在弹出的菜单中选择“插入”——“模块”；
3、步骤3：双击新生成的模块，在右侧代码区，输入如下代码：
Sub 拆分表()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim arr, brr, d
’“总表”是作者测试数据的工作表名称，如果你的总表工作表名称是其他的，如：XXX，把代码中所有的“总表”替换（CTRL+H）成XXX即可。
a = Sheets("总表").[B65000].End(3).Row
’A2:J & a 是作者测试数据中的区域，大家可以改成自己的列表范围
arr = Sheets("总表").Range("A2:J" & a)
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
’为什么是arr(i,8)呢？因为我们是按照数据范围中的第8列内容也就是“供应商”列拆分总表。大家可以按照自己的需要改成某列号即可，下面的arr(i,8)都是这样的修改方式。
d(arr(i, 8)) = d(arr(i, 8)) + ""
Next i
x = Sheets.Count
For j = x To 1 Step -1
If Sheets(j).Name <> "总表" Then
Sheets(j).Delete
End If
Next j
x = Sheets.Count
For Each dic In d
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
Sheets.Add after:=Sheets(x)
x = x + 1
Sheets(x).Name = dic
For i = 1 To UBound(arr)
If arr(i, 8) = dic Then
k = k + 1
For j = 1 To UBound(arr, 2)
brr(k, j) = arr(i, j)
Next j
End If
Next i
Sheets("总表").Range("1:1").Copy Sheets(x).Range("1:1")
’ Range("A2")，是作者被粘贴区域的首个单元格，如果大家需要从其他部分粘贴，就把这里改一下。
Sheets(x).Range("A2").Resize(UBound(brr), UBound(brr, 2)) = brr
Erase brr
k = 0
Next
End Sub
4、步骤4：运行代码，测试代码是否运行正常。
5、步骤5：如果测试代码无误，将.XLSX文件另存为.XLSM文件（启用宏的EXCEL工作薄）。
6、很多学生在初学VBA的时候，经常会忘记另存为.XLSM文件，虽然也能保存，但是保存的是工作表区域的数据，VBE界面的代码是没有被保存的，辛苦付之东流。
7、虽然没有解释代码的含义，但却给出了代码的修改方式。这样一来，会VBA的同学可以看懂；而不会VBA的同学，可以根据不同的场景，修改代码。
8、个人建议
整体操作流程如下。
