一个工作簿里的表格根据部门拆分成不同的工作表

LMY123

拆分工作表，有合并单元格

zyali1006

求教：1、怎么将下面两个VBA合并为一个。第一步，拆分工作表到工作簿；第二步，将工作簿的sheet拆分到单独的excel表格。
2、第一个VBA如果想命名修改为（文件名-部门）的形式，是否可以。
3、同一个工作簿的文件，如果有8个sheet（不同格式，但第一列都是部门），能否一并用第一个VBA。一次性拆分出来不同单个的excel表格(以文件名-部门的形式命名)。

第一步
Sub 拆分()
Application.DisplayAlerts = False
Set d = CreateObject("scripting.dictionary")
Set sht = ActiveSheet
arr = Sheet1.[a1].CurrentRegion
For Each sh In Worksheets
If sh.Name <> sht.Name Then
sh.Delete
End If
Next sh
Application.DisplayAlerts = True
For i = 2 To UBound(arr)
If arr(i, 1) = "" Then
arr(i, 1) = arr(i - 1, 1)
End If
If Not d.exists(arr(i, 1)) Then
Set d(arr(i, 1)) = sht.Range("a" & i).Resize(1, UBound(arr, 2))
Else
Set d(arr(i, 1)) = Union(d(arr(i, 1)), sht.Range("a" & i).Resize(1, UBound(arr, 2)))
End If
Next i
x = d.keys
For i = 0 To UBound(x)
Set sh = Worksheets.Add(after:=Sheets(Sheets.Count))
sh.Name = x(i)
sht.Rows(1).Copy sh.[a1]
d.items()(i).Copy sh.[a2]
Next i
End Sub


第二步：
Private Sub 分拆工作表()
   Dim sht As Worksheet
   Dim MyBook As Workbook
   Set MyBook = ActiveWorkbook
   For Each sht In MyBook.Sheets
       sht.Copy
       ActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & sht.Name, FileFormat:=xlOpenXMLWorkbook     '将工作簿另存为xlsx格式
       ActiveWorkbook.Close
   Next
   MsgBox "文件已经被分拆完毕!"
End Sub