求助一个关于VBA的问题（支持有偿服务）谢谢！

参考：https://blog.csdn.net/hhhhh_51/article/details/122414404

只说思路:
先解决第二个问题，把你那几个工作表汇总成一个。
然后循环筛选一级机构拆分即可。

自顶，求协助。

有点懂你的意思，但是又有点模糊，如果数据源有3-4个表为什么不合并在一起在一起分？数据源总表有3-4个表，然后把这3-4个表在分表，技术上不难。

简而言之：数据源尽量做在一个表，！！！再用数据分析能力，一键出所有想要的结果！

就是把所有sheets汇总成一个表，然后以B列为关键字，将每个关键字内容拆分为单独文件是吧？

简简单单写了一个demo

狗系统老吞我动图

系统是喜欢吞大图

Alt + F11 复制代码进去，F5运行
Option Explicit
Sub 拆分()
Dim dic As Object, ws As Worksheet, wb As Workbook, arr, k, i%
Set dic = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
For Each ws In Sheets
arr = ws.Range("a1").CurrentRegion
For i = 2 To UBound(arr)
'机构在第几列就修改里面的数值2为第几列
dic(arr(i, 2)) = ""
Next i
For Each k In dic.keys()
ws.Range("a1").AutoFilter 2, k
Set wb = Workbooks.Add
ws.Range("a1").CurrentRegion.Copy wb.ActiveSheet.Cells(1, 1)
wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & "-" & k & ".xlsx"
wb.Close
Next k
ws.AutoFilterMode = False
Next ws
Application.ScreenUpdating = True
MsgBox "拆分完成！"
End Sub

【结果】