下面說下在一個工作簿里把里面的一個工作表依據實際需求的條件內容，快速拆分成多個工作表方法。

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

總結

以上是生活随笔為你收集整理的离开当前屏幕的判断方法_EXCEL 一个工作表如何快速拆分多个工作表的方法的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。