Excel VBA宏：拆分多行表头工作表

Sub aaa()
    Dim arr, rng As Range, d As Object, k, t, i&, lc%, sh As Worksheet, ICol%, shp As Shape
    ICol = Application.InputBox("请输入你所要分的列：（如按B列分请输入2）", "提示：", "2", Type:=1)
    If ICol = 0 Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "总表" Then sh.Delete'“总表”为工作表名称，若为其他名称，则相应修改。
    Next
    arr = Range("a1").CurrentRegion
    lc = UBound(arr, 2)
    Set rng = Rows(1)
    Set d = CreateObject("scripting.dictionary")
    For i = 4 To UBound(arr) '若标题为3行,则i=4
        If Not d.Exists(arr(i, ICol)) Then
            Set d(arr(i, ICol)) = Cells(i, 1).Resize(1, lc)
        Else
            Set d(arr(i, ICol)) = Union(d(arr(i, ICol)), Cells(i, 1).Resize(1, lc))
        End If
    Next
    k = d.keys
    t = d.Items
    For i = 0 To d.Count - 1
        Sheets("总表").Copy After:=Sheets(Sheets.Count)'“总表”为工作表名称，若为其他名称，则相应修改。
        With ActiveSheet
            For Each shp In .Shapes
                shp.Delete
            Next
            .Name = k(i)
            .UsedRange.Offset(3).Clear '若有三行标题,则Offset(3)