實用Excel技巧分享：快速拆分工作表的兩種方法

工作表有彙總就有拆分。如何快速拆分工作表呢？本篇文章大家分享效率提高99.99%的快速拆分工作表的兩種方法，希望對大家有所幫助！

各位小夥伴有沒有遇到過這樣的問題：當我們把所有的資訊彙總在一張表裡後，又需要將這張大表按某一條件再拆分成多個工作表。那怎麼才能實現呢？可能最笨的方法就是在原工作表篩選資料然後複製貼上到新工作表，不過這種方法不適合資料多的案例，並且新工作表也需要一一重新命名，顯得繁瑣。今天就給大家介紹兩種快捷實用的工作表拆分方法。

如圖，現在要把這個工作表的內容按城市拆分成多個工作表。

第1種：極速拆分——VBA（文中提供有程式碼）

VBA是EXCEL處理大量重複工作最好用的工具。不過很多人對VBA一竅不通，所以今天給大家分享一段程式碼，並且詳細解釋瞭如何根據實際表格修改程式碼值，方便大家在工作中使用。

（1）按住Alt+F11開啟VBA編輯器，點選「插入」選單下的「模組」。

（2）在右側程式碼視窗輸入下列程式碼。不想動手輸入的可以加群下載已經準備好的程式碼檔案，直接複製貼上即可。

Sub 拆分表()

    Dim i, iRow, iCol, t, iNum As Integer, sh As Worksheet, str As String
    Application.ScreenUpdating = False
    With Worksheets("Sheet1")
     iRow = .Range("A65535").End(xlUp).Row
     iCol = .Range("IV1").End(xlToLeft).Column
     t = 3
        For i = 2 To iRow
            str = .Cells(i, t).Value
            On Error Resume Next
            Set sh = Worksheets(str)
            If Err.Number <> 0 Then
                Set sh = Worksheets.Add(, Worksheets(Worksheets.Count))
                sh.Name = str
            End If
           
            sh.Range("A1").Resize(1, iCol).Value = .Range("A1").Resize(1, iCol).Value
            iNum = sh.Range("A" & Rows.Count).End(xlUp).Row
            sh.Range("A" & iNum + 1).Resize(1, iCol).Value = .Range("A" & i).Resize(1, iCol).Value
            Next i
     End With
Application.ScreenUpdating = True
End Sub
登入後複製

程式碼解析：

這裡用紅色文字表示需要根據實際修改的程式碼引數；'用於表示註釋，其後的文字並不影響程式碼的執行，只是用於說明程式碼的。這裡特意用灰色表示註釋文字。

Sub 拆分表 '檔名稱，根據自己的檔名修改

Dim i, iRow, iCol, t, iNum As Integer, sh As Worksheet, str As String

Application.ScreenUpdating = False '關閉螢幕重新整理

With Worksheets("Sheet1")'雙引號內是工作簿名稱,根據實際工作簿名稱修改

iRow = .Range("A65535").End(xlUp).Row '從A列的最後一行開始向上獲取工作表的行數，一般只改動Range中的列引數，如要工作表有效區域是從B列開始的，值就是B65535

iCol = .Range("IV1").End(xlToLeft).Column'從最後列（IV）第1行開始向左獲取工作表的列數，一般只改動Range中的行引數，如要工作表有效區域是從第2行開始的，值就是IV2

t = 3 't為列數，設定依據哪一列進行拆分，譬如，如果是按E列拆分，這裡就是t=5

For i = 2 To iRow 'i為行數，設定從第幾行開始獲取拆分值，要根據工作表實際改動

str = .Cells(i, t).Value '獲取單元格（i, t）的值作為拆分後的表格名稱

On Error Resume Next

Set sh = Worksheets(str) '建立以上述獲取值為名的工作表

If Err.Number 0 Then '如果不存在這個工作表則新增一個並命名

Set sh = Worksheets.Add(, Worksheets(Worksheets.Count))

sh.Name = str

End If '如果存在這個工作表

sh.Range("A1").Resize(1, iCol).Value = .Range("A1").Resize(1, iCol).Value '獲取工作表標題，一般只改動Range的列值和Resize中的行值，譬如工作表的標題是從B列第3行開始的，則這句程式碼就變成 sh.Range("B1").Resize(3, iCol).Value = .Range("B1").Resize(3, iCol).Value '