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，则DDD具有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

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

1 个答案: