如何按1表格里的内容拆分成拆分后的文件夹中的多个表格

kaka123w

大神们

一个总表中含有合并的单元格，如何按1表格里的内容拆分成    拆分后的   文件夹中的多个表格。具体格式见附件，新的execl文件按表格中的  名称和日期之间的字符  命名

ykcbf1100

总表拆分为多工作簿

ykcbf1100

总表拆分。。。

Qs18

1. Sub qs()
   
2. Application.DisplayAlerts = False: Application.ScreenUpdating = False
   
3. Dim arr, i, xb As Workbook, rng As Range
   
4. arr = Sheet3.UsedRange
   
5. With ThisWorkbook.Sheets("表")
   
6. For i = 1 To UBound(arr)
   
7.     If InStr(arr(i, 1), "中间") Then
   
8.         s = s & "|" & i
   
9.     End If
   
10. Next
    
11. s = s & "|" & UBound(arr) + 2
    
12. ar = Split(Mid(s, 2), "|")
    
13. For i = 0 To UBound(ar) - 1
    
14.    Set rng = .Rows(ar(i) & ":" & ar(i + 1) - 2)
    
15.     Set xb = Workbooks.Add
    
16.     rng.Copy xb.Sheets(1).Range("a1")
    
17.     t = arr(ar(i), 1)
    
18.     mc = InStr(t, "名称：")
    
19.     mc2 = InStr(t, " 日期")
    
20.     m = Mid(t, mc + 3, mc2 - mc - 2)
    
21.     xb.Sheets(1).Name = m
    
22.     xb.SaveAs ThisWorkbook.Path & "\拆分后的表" & m & ".xlsx"
    
23.     xb.Close (True)
    
24. Next
    
25. End With
    
26. Application.DisplayAlerts = True: Application.ScreenUpdating = True
    
27. End Sub

复制代码

Qs18

试试...........

Qs18

试试..........