在實際工作中excel拆分成多個獨立表格，表格的批量拆分與批量合并是很常見的情況，注意是很多個表格，通過人力的方式來做費時費力，本文就來說說如何用VBA實現表格的批量拆分。

首先說業務背景，某公司總部，需要每月跟各分公司確認銷售人員的業績提成，這里有一份根據獎勵政策匯總統計所有分公司的銷售業績提成表，表格如下。

excel拆分成多個獨立表格_把表格拆分獨立excel_表格拆分成多個獨立

以上表格，第一列是銷售人員編號，第二列是銷售人員所屬分公司，第三列是每個銷售人員的業績提成。

那我們需要做什么事呢？

我們需要將各個分公司的數據分開，保存到一個新的表格里，最后另存為一個新的工作簿。

最終的效果如下圖所示。

把表格拆分獨立excel_表格拆分成多個獨立_excel拆分成多個獨立表格

如果手動去拆分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列中的分公司名稱有重復，一旦遇到之前創建過工作表的分公司名稱，再創建工作表就會出現如下圖所示的錯誤。

表格拆分成多個獨立_excel拆分成多個獨立表格_把表格拆分獨立excel

因為工作表的名稱是不能重復的，所以，需要考慮重復的情況。

第二步：考慮重復的新建工作表

考慮到重復，將前面的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代碼，就完成了新建工作表，如下圖所示。

excel拆分成多個獨立表格_把表格拆分獨立excel_表格拆分成多個獨立

第三步：批量對數據分類

此時的新工作表還沒有數據，所以需要將每個分公司的數據篩選出來，然后分別復制到各個分公司的新工作表中。

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

上述代碼的意思就是通過一個循環去遍歷原來的工作表，將每一條記錄按照分公司名稱復制到之前新建的工作表中，只是每次循環的時候都將表頭，也就是第一行的字段名稱，也復制到每個工作表的第一行。

第四步：將工作表保存為新工作簿

此時，每個分公司對應的工作表中已經有了數據，如下圖所示。

excel拆分成多個獨立表格_表格拆分成多個獨立_把表格拆分獨立excel

接下來需要將每個工作表都保存為一個單獨的工作簿，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代碼的意思是將每個工作表保存到當前路徑下的“各分公司業績表”文件夾中，并且命名為工作表的名稱，最終拆分出來的表格如下所示。

表格拆分成多個獨立_把表格拆分獨立excel_excel拆分成多個獨立表格

上圖中，可以看到拆分出來的表格也包括最開始的業績提成表。

以上就是用VBA實現表格的批量拆分，當然這是一個簡化后的表格，實際業務的表格會比這個復雜很多，但是這個表格對于我們理解表格的批量拆分是沒有影響的，因為原理是一樣的。

想要系統學習數據分析？請查看以下專欄。

免責聲明：本文系轉載，版權歸原作者所有；旨在傳遞信息，不代表本站的觀點和立場和對其真實性負責。如需轉載，請聯系原作者。如果來源標注有誤或侵犯了您的合法權益或者其他問題不想在本站發布，來信即刪。