Excel VBA实例：将工作表拆分为多个工作簿

在实际工作中excel拆分成多个独立表格，表格的批量拆分与批量合并是很常见的情况，注意是很多个表格，通过人力的方式来做费时费力，本文就来说说如何用VBA实现表格的批量拆分。

首先说业务背景，某公司总部，需要每月跟各分公司确认销售人员的业绩提成，这里有一份根据奖励政策汇总统计所有分公司的销售业绩提成表，表格如下。

以上表格，第一列是销售人员编号，第二列是销售人员所属分公司，第三列是每个销售人员的业绩提成。

那我们需要做什么事呢？

我们需要将各个分公司的数据分开，保存到一个新的表格里，最后另存为一个新的工作簿。

最终的效果如下图所示。

如果手动去拆分excel拆分成多个独立表格，大致分为以下三步。

针对每个分公司，分别新建一个工作表。将每个分公司的数据筛选出来，保存到对应的工作表里。将每个分公司的工作表另存为新的工作簿。

如果以上这些操作每月都要进行，但是，对于汇总完的数据excel拆分成多个独立表格，按照分公司分离到新表，再另存为新的工作簿完全是一个重复性的“体力活”，而且每月都会浪费一定的时间。

如果通过VBA来解决，前期只要把代码编写好，以后每月执行一次就可以完成任务，可以节省大量的时间。

温馨提示：阅读以下内容需要一定的VBA基础哦。

接下来，说说如何用VBA代码实现。

第一步：新建工作表

按照上表中的分公司名称创建新工作表，VBA代码如下。

Sub shtAdd()
    Dim sht As Worksheet, i As Integer   '新建一个worksheet对象
    i = 2
    Set sht = Worksheets("业绩提成表")
    Do While sht.Cells(i, "B") <> ""
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = sht.Cells(i, "B").Value
    i = i + 1
    Loop
End Sub

上述代码的意思就是通过一个循环对B列中的分公司名称进行循环，即对每一个分公司名称建一个新工作表，并将分公司名称作为新工作表的名称。

可是，这样做有一个问题，B列中的分公司名称有重复，一旦遇到之前创建过工作表的分公司名称，再创建工作表就会出现如下图所示的错误。

因为工作表的名称是不能重复的，所以，需要考虑重复的情况。

第二步：考虑重复的新建工作表

考虑到重复，将前面的VBA代码修改一下。

Sub shtAdd()
    Dim sht As Worksheet, i As Integer
    i = 2
    Set sht = Worksheets("业绩提成表")
    
    Do While sht.Cells(i, "B") <> ""
        On Error Resume Next
        If Worksheets(sht.Cells(i, "B").Value) Is Nothing Then
            Worksheets.Add after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = sht.Cells(i, "B").Value
        End If
    i = i + 1
    Loop
End Sub

上述代码主要修改了两个地方：

1、在循环中增加一个if条件判断，表示当某个分公司名称的表格不存在时，就创建一个新的工作表。

2、增加了一行代码On Next，表示当发生错误时，忽略错误，继续执行下一行。

为啥要增加这行代码？

但是当(sht.(i, "B").)不存在时，会报错。

执行上述VBA代码，就完成了新建工作表，如下图所示。

第三步：批量对数据分类

此时的新工作表还没有数据，所以需要将每个分公司的数据筛选出来，然后分别复制到各个分公司的新工作表中。

VBA代码如下。

Sub fenlei()
    Dim i As Integer, cName As String, rng1 As Range, rng2 As Range
    i = 2
    Worksheets("业绩提成表").Select
    cName = Cells(i, "B").Value
    Do While cName <> ""
        Set rng1 = Worksheets(cName).Range("A1")
        Cells(1, "A").Resize(1, 3).Copy rng1
        
        Set rng2 = Worksheets(cName).Range("A1000").End(xlUp).Offset(1, 0)
        Cells(i, "A").Resize(1, 3).Copy rng2
        i = i + 1
        cName = Cells(i, "B").Value
    Loop
End Sub

上述代码的意思就是通过一个循环去遍历原来的工作表，将每一条记录按照分公司名称复制到之前新建的工作表中，只是每次循环的时候都将表头，也就是第一行的字段名称，也复制到每个工作表的第一行。

第四步：将工作表保存为新工作簿

此时，每个分公司对应的工作表中已经有了数据，如下图所示。

接下来需要将每个工作表都保存为一个单独的工作簿，VBA代码如下。

Sub saveTowb()
    Application.ScreenUpdating = False
    Dim dir As String
    dir = ThisWorkbook.Path & "\各分公司业绩表"
    Dim sht As Worksheet
    
    For Each sht In Worksheets
        sht.Copy
        ActiveWorkbook.SaveAs dir & "\" & sht.Name & ".xlsx"
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True
End Sub

以上VBA代码的意思是将每个工作表保存到当前路径下的“各分公司业绩表”文件夹中，并且命名为工作表的名称，最终拆分出来的表格如下所示。

上图中，可以看到拆分出来的表格也包括最开始的业绩提成表。

以上就是用VBA实现表格的批量拆分，当然这是一个简化后的表格，实际业务的表格会比这个复杂很多，但是这个表格对于我们理解表格的批量拆分是没有影响的，因为原理是一样的。

想要系统学习数据分析？请查看以下专栏。

免责声明：本文系转载，版权归原作者所有；旨在传递信息，不代表本站的观点和立场和对其真实性负责。如需转载，请联系原作者。如果来源标注有误或侵犯了您的合法权益或者其他问题不想在本站发布，来信即删。