数组合并工作表

沈志辉

这是我写的，但是这个方法比普通的复制粘贴还慢，不知道怎么回事，是哪里写的有问题吗
Sub 合并工作表()
    Dim d As Object
    Dim sht As Worksheet
    Dim Items,TempTitle
    Dim TitleCount, ColCount, ShtCount%
    Dim i, TotalRows&
    Set d = CreateObject("Scripting.Dictionary")
    TempTitle = Application.InputBox("请输入表头行数", "表头行数", Default:=1, Type:=1)
    If TypeName(TempTitle) = "Boolean" Then MsgBox "您点击了取消 ，请重新合并 ！", , "取消" : Exit Sub
    TotalRows = 1
    For Each sht In Sheets
        If sht.Name <> ActiveSheet.Name Then
            ShtCount = ShtCount + 1
            ColCount = sht.UsedRange.Columns.Count
            d(ShtCount) = sht.UsedRange.Offset(TitleCount, 0)
            TitleCount = TempTitle
        End If
    Next
    For Each Items In d.Keys
        Cells(TotalRows, 1).Resize(UBound(d(Items)), ColCount) = d(Items)
        TotalRows = ActiveSheet.[A1].UsedRange.Rows.Count + 1
    Next
End Sub