下面說下在一個工作簿裡把裡面的一個工作表依據實際需求的條件内容，快速拆分成多個工作表方法。
1.打開excel檔案，現在需要依據地區和國家這個條件，分别單獨生成不同的工作表出來，最原始的方法是手動建立工作表一個一個的内容複制粘貼，這方法内容比較少是可行的，當倘若一個工作表裡有幾百個内容依據條件分别生成n個獨立的工作表，工作效率低，不建議使用手動建立工作表複制粘貼内容；
2.右鍵工作表，選擇檢視代碼打開VBA視窗，複制輸入以下代碼帶視窗中；
Sub 工作表拆分2() '通過篩選方法完成需求，速度快，但當有合并單元格時就不能用。讀者可以根據實際情況選用
Dim SplitCol As String, ColNum As Integer, HeadRows As Byte, arr, lastrow, i, ShtIndex, only As New Collection, Rng As Range
SplitCol = "D" '指定拆分條件所在列
HeadRows = 1 '指定标題行數，該區域不參與拆分
If HeadRows >= ActiveSheet.UsedRange.Rows.Count Then Exit Sub '如果指定的标題行大于已用區域行數則退出程式
ColNum = Cells(1, SplitCol).Column '将列标轉換成數字
lastrow = ActiveSheet.UsedRange.Rows.Count '擷取目前表已用區域的行數
arr = Range(Cells(HeadRows + 1, SplitCol), Cells(lastrow, SplitCol)).Value '将拆分列的資料賦與變量arr
On Error Resume Next
If ActiveSheet.FilterMode Then Cells.AutoFilter '如果處于篩選模式，那麼去除篩選模式
For i = 1 To lastrow - HeadRows '周遊arr所有資料
'提取其中的不重複值
If Len(arr(i, 1)) > 0 Then only.Add CStr(arr(i, 1)), CStr(arr(i, 1))
Next i
ShtIndex = ActiveSheet.Index '擷取目前表位置
On Error Resume Next
For i = 1 To only.Count
Debug.Print Sheets(only(i)).Name '擷取與only對象中每個元素同名的工作表名（用意為判斷是否存在該工作表）
If Err = 0 Then MsgBox "目前工作簿已存在與待拆分項目同名的工作表“" & only(i) & "”，暫無法拆分", 64, "友情提示": Exit Sub
Err.Clear
Next i
Application.ScreenUpdating = False '關閉螢幕更新，加快執行速度
Application.Calculation = xlCalculationManual '調為手動計算，加快執行速度
For i = 1 To only.Count '建立工作表，表的數量與表名由only對象中不重複值而定
Sheets.Add After:=Sheets(Sheets.Count) '建立
Sheets(Sheets.Count).Name = only(i) '命名
Sheets(ShtIndex).Rows("1:" & HeadRows).Copy Sheets(Sheets.Count).Cells(1, 1) '複制标題
Next i
Sheets(ShtIndex).Select '傳回待拆分工作表
For i = 1 To only.Count '周遊Collection對象所有成員。Collection對象包括了所有拆分條件，即工作表名
'對拆分條件所在列進行篩選，篩選條件是Collection對象中的成員，本例中是部門名稱
Range(Cells(HeadRows, SplitCol), Cells(lastrow, SplitCol)).AutoFilter Field:=1, Criteria1:=only(i)
Set Rng = Range(Cells(HeadRows + 1, SplitCol), Cells(Rows.Count, SplitCol).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow '引用篩選後的資料（整行）
With Sheets(only(i)).UsedRange.Rows(Sheets(only(i)).UsedRange.Rows.Count + 1) '引用拆分後的工作表的已用區域下一行
Rng.Copy .Cells(1) '第一次複制，複制所有資料，僅取其格式
.Cells = Rng.Value '第二次複制，僅複制數值
End With
Next
Cells.AutoFilter '去除篩選模式
Application.ScreenUpdating = True '恢複螢幕更新
Application.Calculation = xlCalculationAutomatic '恢複自動計算
MsgBox "拆分完畢！", 64, "友情提示"
End Sub
3.修改好代碼之後，按下快捷鍵F5鍵運作宏指令即可快速完成工作表的拆分；
4.宏指令說明，SplitCol = "a" '指定拆分條件所在列，這裡以國家地區為拆分條件，它在D列，修改為SplitCol = "D" , 而HeadRows = 1 代表指定标題行數，該區域固定不進行拆分，即拆分出來的每個工作表的首行都會有一個一樣的表頭,拆分之後，之後再對拆分出來的工作表進行格式修飾下，按住shift鍵滑鼠點選多選不要的工作表右鍵進行删除即可。
excel一個工作表拆分多個https://www.zhihu.com/video/1247151257426538496