求助大神帮忙。工作表、工作簿合并，在线急等！

炫酷的夫子

新建文件夹下类似“2016年12月”命名excel文件有很多，打开“2016年12月”，里面的分表也很多，有没有精通VBA的帮忙把所有工作簿的所有工作表合并到“合并”这个表里，在线急等。

gdw831001

站内搜搜合并 工作表

lsc900707

这样的实例真的很多啊。参考代码：
Sub test()
    Dim arB(1 To 100000, 1 To 6)
    tms = Timer
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls")
    Application.ScreenUpdating = False
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(p & f)
            For Each sht In wb.Sheets
                arA = sht.[a1].CurrentRegion
                wb.Close False
                For i = 3 To UBound(arA)
                    If Len(arA(i, 1)) Then
                        m = m + 1
                        arB(m, 1) = m
                        For j = 2 To 6
                            arB(m, j) = arA(i, j)
                        Next
                    End If
                Next
            Next
        End If
        f = Dir
    Loop
    Set wb = Nothing
    With Sheet1
        .Cells.ClearContents
        .Columns("d:e").NumberFormatLocal = "@"
        .[a1].Resize(2, UBound(arA, 2)) = arA
        .[a3].Resize(m, UBound(arB, 2)) = arB
    End With
    Application.ScreenUpdating = True
    MsgBox "汇总完成!用时:" & Format(Timer - tms, "0.000") & "秒", vbInformation
End Sub

abc123281

要实现你的要求  并不难    你的要求不明确  
  1   是汇总每个工作簿中的所有表吗
  2   如果是这样   我查看了你的有些工作簿  第一个表中有些个人信息都一样  那么汇总在一个表中就有重复的数据

lsc900707

代码需要审核，先回传附件以供参考：

炫酷的夫子

非常感谢，达到目的了，多谢各位，下次回答问题前一定先在站内查看。这块的内容确实有，不过还是谢谢各位大佬！

opiona

http://club.excelhome.net/thread-1409141-1-1.html

LMY123

多薄多表合并