Excel VBA е разделен на отделни Excel листове в множество работни книги с няколко листа - excel, vba, excel-vba

Искам да разделя голям лист на 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.

Отговори:

Това трябва да стане. Не е съвсем чист, но всички коментари ви казват как работи и можете да направите необходимите промени. Променете пътя на папката на ред "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