最佳答案首先说业务背景，某公司总部，需要每月跟各分公司确认销售人员的业绩提成，这里有一份根据奖励政策汇总统计所有分公司的销售业绩提成表，表格如下。以上表格，第一列是销售人员编号，第二列是销售人员所属分公司，第三列是每个销售人员的业绩提成。那我们需要做什么事呢？我们需要将各个分公司的数据分开，保存到一个新的表......
首先说业务背景，某公司总部，需要每月跟各分公司确认销售人员的业绩提成，这里有一份根据奖励政策汇总统计所有分公司的销售业绩提成表，表格如下。
以上表格，第一列是销售人员编号，第二列是销售人员所属分公司，第三列是每个销售人员的业绩提成。
那我们需要做什么事呢？
我们需要将各个分公司的数据分开，保存到一个新的表格里，最后另存为一个新的工作簿。
最终的效果如下图所示。
如果手动去拆分，大致分为以下三步。
- 针对每个分公司，分别新建一个工作表。
- 将每个分公司的数据筛选出来，保存到对应的工作表里。
- 将每个分公司的工作表另存为新的工作簿。
如果以上这些操作每月都要进行，但是，对于汇总完的数据，按照分公司分离到新表，再另存为新的工作簿完全是一个重复性的“体力活”，而且每月都会浪费一定的时间。
如果通过VBA来解决，前期只要把代码编写好，以后每月执行一次就可以完成任务，可以节省大量的时间。
温馨提示：阅读以下内容需要一定的VBA基础哦。
接下来，说说如何用VBA代码实现。
第一步：新建工作表
按照上表中的分公司名称创建新工作表，VBA代码如下。
Sub shtAdd()Dim sht As Worksheet, i As Integer '新建一个worksheet对象i = 2Set sht = Worksheets("业绩提成表")Do While sht.Cells(i, "B") <> ""Worksheets.Add after:=Worksheets(Worksheets.Count)ActiveSheet.Name = sht.Cells(i, "B").Valuei = i + 1LoopEnd Sub上述代码的意思就是通过一个循环对B列中的分公司名称进行循环，即对每一个分公司名称建一个新工作表，并将分公司名称作为新工作表的名称。
可是，这样做有一个问题，B列中的分公司名称有重复，一旦遇到之前创建过工作表的分公司名称，再创建工作表就会出现如下图所示的错误。
因为Excel工作表的名称是不能重复的，所以，需要考虑重复的情况。
第二步：考虑重复的新建工作表
考虑到重复，将前面的VBA代码修改一下。
Sub shtAdd()Dim sht As Worksheet, i As Integeri = 2Set sht = Worksheets("业绩提成表")Do While sht.Cells(i, "B") <> ""On Error Resume NextIf Worksheets(sht.Cells(i, "B").Value) Is Nothing ThenWorksheets.Add after:=Worksheets(Worksheets.Count)ActiveSheet.Name = sht.Cells(i, "B").ValueEnd Ifi = i + 1LoopEnd Sub上述代码主要修改了两个地方：
1、在循环中增加一个if条件判断，表示当某个分公司名称的表格不存在时，就创建一个新的工作表。
2、增加了一行代码On Error Resume Next，表示当发生错误时，忽略错误，继续执行下一行。
为啥要增加这行代码？
但是当Worksheets(sht.Cells(i, “B”).Value)不存在时，会报错。
执行上述VBA代码，就完成了新建工作表，如下图所示。
第三步：批量对数据分类
此时的新工作表还没有数据，所以需要将每个分公司的数据筛选出来，然后分别复制到各个分公司的新工作表中。
VBA代码如下。
Sub fenlei()Dim i As Integer, cName As String, rng1 As Range, rng2 As Rangei = 2Worksheets("业绩提成表").SelectcName = Cells(i, "B").ValueDo While cName <> ""Set rng1 = Worksheets(cName).Range("A1")Cells(1, "A").Resize(1, 3).Copy rng1Set rng2 = Worksheets(cName).Range("A1000").End(xlUp).Offset(1, 0)Cells(i, "A").Resize(1, 3).Copy rng2i = i + 1cName = Cells(i, "B").ValueLoopEnd Sub上述代码的意思就是通过一个循环去遍历原来的工作表，将每一条记录按照分公司名称复制到之前新建的工作表中，只是每次循环的时候都将表头，也就是第一行的字段名称，也复制到每个工作表的第一行。
第四步：将工作表保存为新工作簿
此时，每个分公司对应的工作表中已经有了数据，如下图所示。
接下来需要将每个工作表都保存为一个单独的工作簿，VBA代码如下。
Sub saveTowb()Application.ScreenUpdating = FalseDim dir As Stringdir = ThisWorkbook.Path & "\各分公司业绩表"Dim sht As WorksheetFor Each sht In Worksheetssht.CopyActiveWorkbook.SaveAs dir & "\" & sht.Name & ".xlsx"ActiveWorkbook.CloseNextApplication.ScreenUpdating = TrueEnd Sub以上VBA代码的意思是将每个工作表保存到当前路径下的“各分公司业绩表”文件夹中，并且命名为工作表的名称，最终拆分出来的表格如下所示。
上图中，可以看到拆分出来的表格也包括最开始的业绩提成表。
