Excel VBA将多张工作簿拆分为多个工作表

Question

我希望将一个大型的Excel工作表拆分为多个工作簿，其中包含多个工作表。

例子：

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 

其中一个名为BBB工作簿将有床单217-226页，CCC具有300-306，国内有444-447。工作簿名称从B2开始，相应的工作表从C2开始。

Answer 1

这应该做。不是很整齐，但所有的评论告诉你它是如何工作的，你可以做出必要的改变。将行“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 

干杯

帕斯卡尔

http://multiskillz.tekcities.com