VBA:合并同一文件夹下的所有表

同一文件夹下由n多表，且表的格式相同，需要将表合并在一张表中，以方便统计。 

Sub 合同同一文件夹下的所有表()

    Dim r As Long, c As Long

    r = 1

    c = 37    'c的值是为了控制有几列，可以根据实际情况调整

    Range(Cells(r, "A"), Cells(65536, c)).ClearContents  '合并前先清空所在表

    Application.ScreenUpdating = False

    Dim filename As String, wb As Workbook, sht As Worksheet, erow As Long, fn As String, arr As Variant, flag As Integer

    filename = Dir(ThisWorkbook.Path & "\*.xls")   '获取该文件夹下的所有表的表名

    flag = 1

    Do While filename <> ""

        If filename <> ThisWorkbook.Name Then   '为了避免合并的总表自己调用自己

            If flag = 1 Then

            erow = 1

            Else

            erow = Range("A1").CurrentRegion.Rows.Count + 1    '为了找出要粘贴到汇总表的位置

            End If

        fn = ThisWorkbook.Path & "\" & filename

        Set wb = GetObject(fn)        '在后台打开一张表

        Set sht = wb.Worksheets(1)    '只合并该工作簿中的第一张表

            If flag = 1 Then       '该flag是为避免重复复制表头而设置

            arr = sht.Range(sht.Cells(r, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, c))    'arr找到要复制的区域，运行此句时含表头

            Else

            arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, c))  'arr找到要复制的区域，运行此句时不含表头

            End If

        Cells(erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr   'UBound(arr, 1)计算出行数，UBound(arr, 2)计算出列数

        wb.Close False     '将刚才打开的表关闭

        End If

        filename = Dir     '运行此句时filename获取下一个表的表名

        flag = 2

    Loop

    Application.ScreenUpdating = True

End Sub