在各行各業的日常工作中，經常需要把一份工作表的內容歸類拆分到N個工作簿，最基礎的辦法就是通過篩選、排序歸類數據，然后復制原數據，再新建工作簿，粘貼數據，如此往復......如果數量較小，這樣操作沒問題，如果分類的數據非常多，要新建幾百，幾千個工作簿，那就是一個非常大的工作量了。
此時就需要使用批量處理的方法，可以用PQ，也可以用VBA，本文就分享用VBA來處理批量拆分工作簿，用VBA的好處在于，只要代碼寫好，不需要懂代碼，任何人都可以直接拿來用，其他辦法就需要對軟件操作有一些要求了。
以下圖這個表格為例：
工作場景：這是一位學員給我提出的問題，她說這個表格每個星期要做一次，需要把這個表格按A列的店鋪名稱歸類到一起然后拆分到工作簿，A列中有幾個店就要拆分成幾個工作簿，并且還要保留原來的批注圖片，拆分出來的工作簿名稱以店鋪名稱命名。
這個問題的關鍵點：
1、A列的店鋪是無序的
2、保留表格中的批注圖片
3、工作簿命名為對應的店鋪名稱
OK，問題描述清楚了，那就開始講解VBA操作步驟。
VBA操作步驟
1、首先表格需要打開宏設置，點擊文件——Excel選項——信任中心——信任中心設置——宏設置——啟用所有宏，然后點擊確定。
這個步驟，每臺電腦只要設置過一次，以后都默認開啟，如果你以前用過VBA那這個步驟可以略過。
2、鼠標放在原數據所在的工作表，點擊鼠標右鍵，查看代碼，進入VBA編輯界面
將代碼復制到上圖所示的區域中。
復制下面的代碼↓↓↓↓↓↓（黑色加粗部分）
Sub 按A列區分內容并拆分到工作薄()
Dim i%
arr = Sheets(1).[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
If d.exists(arr(i, 1)) Then
Set d(arr(i, 1)) = Union(d(arr(i, 1)), Rows(i))
Else
Set d(arr(i, 1)) = Union(Rows(1), Rows(i))
End If
Next i
For ss = 0 To d.Count - 1
Workbooks.Add
With ActiveWorkbook
d.items()(ss).Copy .Sheets(1).[a1]
.SaveAs ThisWorkbook.Path & "/" & d.keys()(ss)
.Close
End With
Next ss
MsgBox "快學Excel提示您，工作薄拆分完畢！"
End Sub
3、點擊運行(點擊綠色三角形)，代碼運行時，屏幕會閃爍，拆分出來的新工作簿會放在原工作簿的路徑里。如果原工作簿放在一個文件夾，那新拆分出來的工作簿也會在這個文件夾里，如果原工作簿放在桌面，那拆分出來的工作簿就會放在桌面上。當拆分完畢時，會彈出提示框，表明代碼運行完畢。
拆分完畢后，新工作薄以店鋪名稱命名
拆分完后隨意打開一張看一下，店鋪名稱已經歸類拆分好了，并且批注圖片保留下來了。
如何根據自己的需求修改代碼？
上面的案例所用的代碼默認表格的格式為：表頭一行，拆分依據為A列
1、如果我的表頭是一行，但是我以B列為依據拆分應該如何對代碼進行調整呢？
把代碼的這4處（下圖中紅框標記處）修改為2
如果以C列為拆分依據就修改成3，以此類推。
2、如果我的表頭是多行并且表頭有合并單元格怎么改代碼？
如下圖所示，表頭是2行，并且有合并單元格，以B列為拆分依據
表頭有合并單元對代碼運行沒有任何影響，無需針對這個修改代碼。
表頭如果是兩行需要對代碼，上面紅框處把2修改成3，下面紅框處rows(1)修改成rows("1:2")
如果表頭是3行，上面紅框就修改成4，下面紅框處就修改成rows("1:3") 以此類推。
好了關于如何用VBA拆分工作簿就分享到這里，如果這篇文章能幫助到你請點贊，收藏，你的點贊是我繼續創作的動力。
本文由快學excel原創，歡迎大家關注。
