用VBA对同一文件夹下200个工作簿执行拆分表页操作

晨安幕晓

想在每个工作簿中执行这个代码，并且自动循环到下一个工作簿，求各位大神指导

Sub 单位拆分()

    MsgBox "下面将把Sheet1按月份 分到各个工作表中!"

    Dim arr, sht As Worksheet, temp As String,i As Long, k, t, rng1 As Range, rng2 As Range

    Set rng1 = Range("A1:B1")'判断提取范围

    arr = Range("A2:B" &[a65536].End(xlUp).Row).Value

    Application.ScreenUpdating = False

    WithCreateObject("scripting.dictionary")

        For i = 1 To UBound(arr)

            temp = arr(i, 2) '判断以哪一列来区分创建工作表名

            If temp <> "" Then

                If Not .exists(temp) Then

                    .Add temp,Range("a" & i + 1).Resize(1, 2) '判断提取范围

                Else

                    Set .Item(temp) =Union(.Item(temp), Range("a" & i + 1).Resize(1, 2))

                End If

            End If

        Next i

        k = .keys

        t = .Items

        On Error Resume Next

        For i = 0 To .Count - 1

            If Len(Sheets(k(i)).Name) > 0Then '判断工作表存在

                If Err.Number = 9 Then '如果不存在则添加

                   Sheets.Add(after:=Sheets(Sheets.Count)).Name = k(i)

                    .Activate

                End If

            End If

            With Sheets(k(i))

                .Cells.Clear

                rng1.Copy.Range("a1") '把表头的前一行也一同复制到新工作表中

                t(i).Copy.Range("a2")

            End With

        Next

    End With

End Sub