EXCEL将多张工作薄，指定工作表信息，汇总到一张工作表

yjwdjfqb

EXCEL将多张工作薄，指定工作表信息，汇总到一张工作表
如图：

EXCEL将多张工作薄，指定工作表信息，汇总到一张工作表.rar (51.2 KB, 下载次数: 13)

2018-6-15 11:54 上传

点击文件名下载附件

这个文件中的代码是拆分的，我想修改成一个，多表汇总的，请老师们帮帮忙，谢谢老师们了！

lsc900707

Sub gj23w98()
    t = Timer
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls")
    Application.ScreenUpdating = False
    ReDim brr(1 To 10000, 1 To 7)
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            n = n + 1
            Set sht = GetObject(p & f).Sheets(1)
            arr = sht.[b1].CurrentRegion
            Workbooks(f).Close False
            s = Array(arr(3, 4), arr(2, 2), arr(3, 2), arr(2, 4), arr(4, 2), arr(5, 4), arr(5, 2))
            m = m + 1
            For j = 1 To 7
                brr(m, j) = s(j - 1)
            Next
        End If
        f = Dir
    Loop
    Set sht = Nothing
    With Sheet1
         .[a1].CurrentRegion.Offset(1).ClearContents
         .[a2].Resize(m, 7) = brr
    End With
    Application.ScreenUpdating = True
    MsgBox "汇总了：" & n & "个工作表；共有：" & m & "行数据 " & vbCr & "用时：" & Format(Timer - t, "0.00") & "秒", vbInformation
End Sub

lsc900707

附件供参考：

yjwdjfqb

lsc900707 发表于 2018-6-15 14:13
附件供参考：

谢谢老师帮助！