Excel提示：根據列值將資料分割為多個工作表/工作簿

在 Excel 中管理大型資料集時，根據特定列值將資料拆分為多個工作表非常有益。這種方法不僅改進了數據的組織，還增強了可讀性並有利於更輕鬆的數據分析。

假設您有一個大型銷售記錄，其中包含多個條目，例如產品名稱、第一季的銷售數量。目標是根據每個產品名稱將這些數據拆分為單獨的工作表，以便可以單獨分析各個銷售業績。

根據列值將資料拆分為多個工作表

• 透過使用VBA程式碼
• 透過使用強大的功能-Kutools for Excel

使用 VBA 程式碼根據列值將資料拆分為多個工作簿

根據列值將資料拆分為多個工作表

通常，您可以先對資料清單進行排序，然後將它們逐一複製並貼上到其他新工作表中。但這需要你耐心地反覆複製和貼上。在本節中，我們將介紹兩種簡單的方法來在 Excel 中有效地解決此任務，從而節省您的時間並減少錯誤的可能性。

使用 VBA 程式碼根據列值將資料拆分為多個工作表

1.按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2。 點擊 插入 > 模塊，然後將以下代碼粘貼到“模塊窗口”中。

Sub Splitdatabycol()
'updateby Extendoffice
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Set xWS = Sheets.Add(after:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
xWS.Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

3。 然後，按 F5 鍵運行程式碼，彈出提示框提醒您選擇標題行，然後按一下 OK。 看截圖：

4. 在第二個提示框中，請選擇您要分割的列數據，然後按一下 OK。 看截圖：

5. 活動工作表中的所有資料依列值分為多個工作表。產生的工作表根據分割儲存格中的值命名，並放置在工作簿的末端。看截圖：

使用 Kutools for Excel 根據列值將資料拆分為多個工作表

Excel的Kutools 帶來智慧功能—— 拆分數據 直接進入您的 Excel 環境。將資料拆分為多個工作表不再是一個挑戰。我們直覺的工具會根據所選的列值或行數自動劃分資料集，確保每個資訊都位於您需要的位置。告別手動組織電子表格的繁瑣任務，採用更快、無錯誤的方式來管理資料。

安裝後 Excel的Kutools，選擇資料範圍，然後按一下 Kutools 加 > 拆分數據 打開 將資料拆分為多個工作表 對話框。

1. 選擇 特定欄 在選項 分割依據 部分，然後從下拉清單中選擇要分割資料的列值。
2. 如果您的資料有標題並且您想要將它們插入到每個新的分割工作表中，請檢查 我的數據有標題 選項。 （您可以根據您的資料指定標題行數。例如，如果您的資料包含兩個標題，請鍵入 2。）
3. 然後，您可以在 新工作表名稱 部分，從規則下拉清單中指定工作表名稱規則，您可以新增 字首 or 後綴 以及工作表名稱。
4. 點擊 OK 按鈕。 看截圖：
   

現在，工作表中的資料被分割為新工作簿中的多個工作表。

使用 VBA 程式碼根據列值將資料拆分為多個工作簿

有時，與將資料劃分為多​​個工作表相比，基於鍵列將資料劃分為單獨的工作簿可能更有利。以下逐步指南介紹如何使用 VBA 程式碼自動根據特定列值將資料拆分為多個工作簿的流程。

1.按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2。 點擊 插入 > 模塊，然後將以下代碼粘貼到 模塊窗口.

Sub SplitDataByColToWorkbooks()
    ' Updateby Extendoffice
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    Dim xTRg As Range
    Dim xVRg As Range
    Dim xWS As Workbook
    Dim savePath As String
    ' Set the directory to save new workbooks
    savePath = "C:\Users\AddinsVM001\Desktop\multiple files\" ' Modify this path as needed
    Application.DisplayAlerts = False
    Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", Type:=8)
    If TypeName(xTRg) = "Nothing" Then Exit Sub
    Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", Type:=8)
    If TypeName(xVRg) = "Nothing" Then Exit Sub
    vcol = xVRg.Column
    Set ws = xTRg.Worksheet
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = xTRg.Address(False, False)
    titlerow = xTRg.Row
    ws.Columns(vcol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, ws.Columns.Count), Unique:=True
    myarr = Application.Transpose(ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).Value)
    ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).ClearContents
    For i = 2 To UBound(myarr)
        Set xWS = Workbooks.Add
        ws.Range(title).AutoFilter Field:=vcol, Criteria1:=myarr(i)
        ws.Range("A" & titlerow & ":A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        xWS.Sheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteAll
        xWS.SaveAs Filename:=savePath & myarr(i) & ".xlsx"

        xWS.Close SaveChanges:=False
    Next i
    ws.AutoFilterMode = False
    Application.DisplayAlerts = True
    ws.Activate
End Sub

3。 然後，按 F5 鍵運行程式碼，彈出提示框提醒您選擇標題行，然後按一下 OK。 看截圖：

4. 在第二個提示框中，請選擇您要分割的列數據，然後按一下 OK。 看截圖：

5. 拆分後，活動工作表中的所有資料將根據列值分為多個工作簿。所有分割的工作簿都會儲存到您指定的資料夾中。看截圖：

相關文章：

最佳辦公生產力工具

🤖	Kutools 人工智慧助手：基於以下內容徹底改變數據分析： 智慧執行   |  生成代碼  |  建立自訂公式  |  分析數據並產生圖表  |  呼叫 Kutools 函數...
	熱門特色: 尋找、突出顯示或識別重複項   |  刪除空白行   |  合併列或儲存格而不遺失數據   |   沒有公式的回合 ...
	超級查詢: 多條件VLookup  |   多值VLookup  |   跨多個工作表的 VLookup   |   模糊查詢 ....
	高級下拉列表: 快速建立下拉列表   |  依賴下拉列表   |  多選下拉列表 ....
	欄目經理: 新增特定數量的列  |  移動列  |  切換隱藏列的可見性狀態  |  比較範圍和列 ...
	特色功能: 網格焦點   |  設計圖   |   大方程式酒吧   |  工作簿和工作表管理器   |  資源庫 （自動文字）   |  日期選擇器   |  合併工作表   |  加密/解密單元格   |  按清單發送電子郵件   |  超級濾鏡   |   特殊過濾器 （過濾粗體/斜體/刪除線...）...
	前 15 個工具集:  12 文本 工具 (添加文本, 刪除字符，...）   |   50+ 圖表 類型 (甘特圖，...）   |   40+ 實用 公式 (根據生日計算年齡，...）   |   19 插入 工具 (插入二維碼, 從路徑插入圖片，...）   |   12 轉化 工具 (數字到單詞, 貨幣兌換，...）   |   7 合併與拆分 工具 (高級合併行, 分裂細胞，...）   |   ... 和更多

使用 Kutools for Excel 增強您的 Excel 技能，體驗前所未有的效率。 Kutools for Excel 提供了 300 多種進階功能來提高生產力並節省時間。  點擊此處獲取您最需要的功能...

閱讀更多... 免費下載...

---

Office選項卡為Office帶來了選項卡式界面，使您的工作更加輕鬆

• 在Word，Excel，PowerPoint中啟用選項卡式編輯和閱讀，發布者，Access，Visio和Project。
• 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
• 將您的工作效率提高 50%，每天為您減少數百次鼠標點擊！

閱讀更多... 免費下載...