工作中，常常會根據工作表的某一內容來拆分工作博并按照指定的命名新建工作簿，且放入指定的路徑文件夾下面。今天就拿昨天的例子，來分享一下如何通過幾行代碼，快速的拆分工作簿

源數據：

目標工作簿及內容：

問題描述：

1：工資表的原始表格里已經做好了各同事的工資表格；

2：要把每一個同事的工作條提取出來放入新的工作簿里面；

3：工作薄放入指定的文件夾下面；

4：工作薄按照姓名來命名；

解決的思路詳解：

繼承昨天文章的大致思路

1：把表頭作為一個單元格區域并賦值；

2：用for循環遍歷工資表區域，提取姓名；

3：用姓名來創建新的工作表；

4：把表頭及工作表的內容放入新建的工作簿；

5：關閉并保存工作簿；

代碼運行的結果如下：

代碼如下:

Sub 生成工資條() Sub 拆分工作簿() Application.DisplayAlerts = False Application.ScreenUpdating = False Dim sht As Worksheet, arr, i, j Dim rng As Range, Path1 As String Dim name As String '獲取當前工作簿的路徑 Path1 = ThisWorkbook.Path & "" '設定數據工作表 Set sht = Worksheets("工資表原始表格") '設定標題欄 Set rng = sht.Range("a2:t3") '設定數據源的區域 arr = sht.Range("a1").CurrentRegion '最后一行有合計，所以需要減1 n = UBound(arr, 1) - 1 For i = n To 4 Step -1 'name新建工作簿的名稱 name = arr(i, 3) Workbooks.Add.SaveAs Path1 & name & ".xlsx" '復制表頭的區域 rng.Copy ActiveSheet.Range("a1") For j = 1 To UBound(arr, 2) Cells(3, j) = arr(i, j) Next '保存并關閉工作簿 Workbooks(name & ".xlsx").Close savechanges:=True Next Application.ScreenUpdating = True Application.DisplayAlerts = TrueEnd Sub End Sub

代碼解析

1：2行 關閉Excel自帶的對話框；

2：5~7行 DIM定義變量；

3：9行 獲取當前工作簿的路徑(可以修改成需要的路徑)；

4：11行 設定源數據的工作表(可以修改成需要的工作表名稱)

5：13行 設置指定的表頭區域(可以修改成需要的表頭區域)；

6：15行 獲取工資表的全部內容；

7：17行 獲取最后一行有效數據的行號

8：18~29行 開始遍歷工資表區域的內容

9：20行 提取作為新工作簿的名稱

10：21行 新建一個工作簿；

11：23行 在新的工作表復制表頭；

12：25行 遍歷工資表區域的內容，賦值給新的工作表

13：18行 關閉指定工作簿并保存

本例思考：

1：本例作為拆分工作博的典型案例，只需要通過幾處的代碼，即可擴大代碼的使用范圍。

小結：

解決本問題，需要用的知識點：

1：工作簿的新建及閉關

延伸閱讀：

《Excel VBA 一鍵工資表制作工資條》

VBA中新建、打開、保存、關閉工作簿！

Excel VBA 拆分工作薄-數組方法

Excel VBA 按工作表名稱拆分工作簿

點擊關注可以更方便的查看Excel VBA的案例文章

私信 視頻 可以獲取54集VBA入門視頻

私信 VBA或 vba 可以獲取文章中含VBA代碼的Excle文件

總結

以上是生活随笔為你收集整理的拆分工作簿为多个文件_掌握这几行代码，快速拆分Excel工作簿（内含源码）的全部內容，希望文章能夠幫你解決所遇到的問題。

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