Excel VBA 将单个 Excel 工作表拆分为具有多个工作表的多个工作簿
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21243610/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA split single excel sheet into multiple workbooks with multiple sheets
提问by Angrypirate
I am wanting to split a large excel sheet into multiple workbooks with a varying number of sheets.
我想将一个大的 excel 工作表拆分成多个工作簿，其中工作表的数量不同。
Example:
例子：
BBB 217
BBB 218
BBB 219
BBB 220
BBB 221
BBB 222
BBB 223
BBB 224
BBB 225
BBB 226
CCC 300
CCC 301
CCC 302
CCC 303
CCC 304
CCC 305
CCC 306
DDD 444
DDD 445
DDD 446
DDD 447
Where a workbook named BBB would have sheets 217-226, CCC has 300-306, DDD has 444-447. Workbook names start in B2 and corresponding sheets start in C2.
名为 BBB 的工作簿的工作表为 217-226，CCC 为 300-306，DDD 为 444-447。工作簿名称以 B2 开头，相应的工作表以 C2 开头。
回答by pascalb
This should do. Not very neat but all the comments tell you how it works and you can make necessary changes. Change folder path on line "AAA" to your folder path.
这个应该可以。不是很整洁，但所有评论都会告诉您它是如何工作的，您可以进行必要的更改。将“AAA”行上的文件夹路径更改为您的文件夹路径。
Sub splitWorkbooksWorksheet()
Dim splitPath As String
Dim w As Workbook 'added workbook objects
Dim ws As Worksheet 'added worksheet objects
Dim wsh As Worksheet 'current active worksheet
Dim i As Long, j As Long
Dim lastr As Long
Dim wbkName As String
Dim wksName As String
Set wsh = ThisWorkbook.Worksheets(1)
splitPath = "G:\splitWb\" 'AAA --- PATH TO FOLDER WHERE TO SAVE WORKBOOKS
'last row based on column C worksheet names
lastr = wsh.Cells(Rows.Count, 3).End(xlUp).Row
'workbook object
Set w = Workbooks.Add
'this loop through each rows from row 1
'and set new worksheets in workbook w
'check if next rows carries the same
'workbook name if not save and close workbook w
For i = 1 To lastr
wbkName = wsh.Cells(i, 2)
w.Worksheets.Add(After:=w.Worksheets(Worksheets.Count)).Name = wsh.Cells(i, 3)
If Not wsh.Cells(i + 1, 2) Like wsh.Cells(i, 2) Then
w.SaveAs splitPath & wsh.Cells(i, 2)
w.Close
Set w = Workbooks.Add
End If
Next i
End Sub
Cheers
干杯
Pascal
帕斯卡
