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 iSheets("总表").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 NextEnd Sub
4、步骤4：运行代码，测试代码是否运行正常。
5、步骤5：如果测试代码无误，将.XLSX文件另存为.XLSM文件（启用宏的EXCEL工作薄）。
6、很多学生在初学VBA的时候，经常会忘记另存为.XLSM文件，虽然也能保存，但是保存的是工作表区域的数据，VBE界面的代码是没有被保存的，辛苦付之东流。
7、虽然没有解释代码的含义，但却给出了代码的修改方式。这样一来，会VBA的同学可以看懂；而不会VBA的同学，可以根据不同的场景，修改代码。
8、个人建议整体操作流程如下。
