自动获取指定文件夹中多个格式相同的excel中的数据

[qq_45554223]

现在同一个文件夹a中有格式相同的表1，表2，表3。我现在需要在一个新的表5中自动获得这三张表的数据，当文件夹a中再增加一个相同格式的表4时，表5中的数据会又会自动更新，应该如何操作

[VB业余爱好者]

你这个得自动伺服，定时刷新那个文件夹，当文件夹夹中文件发生变动，就把表5中的数据更新掉

[hzg303]

Sub HzwWb()
    Dim bt As Range, r As Long, c As Long
    r = 1                                                                   '表头行数
    c = 4                                                                   '表头列数
    Range(Cells(r + 1, "a"), Cells(1024576, c)).ClearContents               '清除汇总表中原数据
    Application.ScreenUpdating = False
    Dim filename As String, wb As Workbook, erow As Long, fn As String, arr As Variant
    filename = Dir(ThisWorkbook.Path & "\*.xls")
        Do While filename <> ""
            If filename <> ThisWorkbook.Name Then                               '判断文件是否是本工作簿
                erow = Range("a1").CurrentRegion.Rows.Count + 1            '取得汇总表中第一条空行行号
                fn = ThisWorkbook.Path & "\" & filename
                Set wb = GetObject(fn)                                                           '将fn代表的工作簿变量赋给wb
                Set sht = wb.Worksheets(1)                                       '汇总的是每个工作簿中的第一张工作表
                '将数据表中的记录保存在arr变量中                
                arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(1024576, "B").End(xlUp).Offset(0, c - 1))   
               '将arr数据写入汇总表                
                Cells(erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr                             
                wb.Close False
            End If
            filename = Dir                                                                 '用dir函数取得其他文件名，并赋给变量
        Loop
    Application.ScreenUpdating = True
End Sub



搬来的供你参考*************************