【求助】数据汇总

牧先森

【求助】
背景：工作中遇到的问题。给客户发送了excel模板，客户的各个部门会根据模板填列数据。
困难：现在需要将各部门填列的数据汇总到一张表上，但数据量过大，一条一条粘贴不现实
求助有无较为便捷的自动化处理方法。

lcluck2002

1、确保每个文件的名称一致。
2、确保每个文件的结构一致。
3、操作一两个，录制一段宏代码，略微修改宏代码，把其他文件包含进去就OK了。

3190496160

Sub 汇总()
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Worksheets(1)
r = sh.Cells(Rows.Count, 2).End(xlUp).Row
sh.Range("b5:i" & r) = Empty
ar = sh.Range("a1:i" & r)
f = Dir(ThisWorkbook.Path & "\*.xls*")
Do While f <> ""
    If f <> ThisWorkbook.Name And f <> "模板" Then
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
        With wb.Worksheets(1)
            rs = .Cells(Rows.Count, 2).End(xlUp).Row
            br = .Range("a1:i" & rs)
        End With
        For i = 5 To UBound(br)
            If Trim(br(i, 2)) <> "" Then
                For j = 2 To UBound(br, 2)
                    ar(i, j) = br(i, j)
                Next j
            End If
        Next i
        wb.Close False
    End If
f = Dir
Loop
sh.Range("a1:i" & r) = ar
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

新建文件夹.rar (62.22 KB, 下载次数: 6)

2021-9-28 14:27 上传

点击文件名下载附件

ydat0595

你备注栏的需要保留吗

牧先森

3190496160 发表于 2021-9-28 14:26
Sub 汇总()
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Worksheets(1)

非常感谢！！！

牧先森

ydat0595 发表于 2021-9-28 15:53
你备注栏的需要保留吗

需要保留的，请问怎么处理呢？