萌新求助，如何用vba统计同一文件夹指定表格所有内容？

星尘锁链

求大神普及，在同一文件夹内有相同格式的表格，想提取出统计栏工作表里第七行，汇总到一个表格，（另外还有第11行第17行的数据也需要汇总），如果能在第一列加上文件的名称就更完美了。
纯萌新，教程的代码完全不知道该怎么弄，求大神赐教，自己试试举一反三。感谢，感谢

weare2

还有的文件呢?

星尘锁链

weare2 发表于 2019-10-12 19:40
还有的文件呢?

没了，就这一个表啊

weare2

星尘锁链 发表于 2019-10-13 13:17
没了，就这一个表啊

看不懂你的要求

蓝桥玄霜

在文件夹中新建一工作簿，加入代码即可。

星尘锁链

蓝桥玄霜 发表于 2019-10-18 14:57
在文件夹中新建一工作簿，加入代码即可。

感谢大佬解疑

星尘锁链

蓝桥玄霜 发表于 2019-10-18 14:57
在文件夹中新建一工作簿，加入代码即可。

之前照着其他人写的的直接大力出奇迹挨个输的单元格Sub 清除内容()
With Worksheets("汇总")
  .Range("a3:ZZ1000").ClearContents
End With
End Sub
Sub 汇总123()
Dim arr, brr(1 To 1, 1 To 70)
Dim wb As Workbook
Dim ws As Worksheet
Dim mbrng As Range
Dim mypath$, myname$
Application.DisplayAlerts = False
Application.ScreenUpdating = False
mypath = ThisWorkbook.Path & "\"
myname = Dir(mypath & "*.xls*")
Do While myname <> ""
  If myname <> ThisWorkbook.Name Then
     Set wb = GetObject(mypath & myname)
     With wb
        With .Worksheets("统计栏")
           arr = .Range("a1:ak22")
           brr(1, 1) = Split(wb.Name, ".")(0)
           brr(1, 2) = arr(7, 2) '
           brr(1, 3) = arr(7, 3) '
           brr(1, 4) = arr(7, 4) '
           brr(1, 5) = arr(7, 5) '
           brr(1, 6) = arr(7, 6) '
           brr(1, 7) = arr(7, 7) '

           brr(1, 8) = arr(17, 22) '
           brr(1, 9) = arr(17, 23) '
           brr(1, 10) = arr(17, 24) '
           brr(1, 11) = arr(17, 25) '
           brr(1, 12) = arr(17, 26) '
           brr(1, 13) = arr(17, 27) '

           brr(1, 14) = arr(7, 8) '
           brr(1, 15) = arr(7, 9)
           brr(1, 16) = arr(7, 10)

           brr(1, 17) = arr(7, 11)
           brr(1, 18) = arr(7, 12)
           brr(1, 19) = arr(7, 13)
           brr(1, 20) = arr(7, 14)
           brr(1, 21) = arr(7, 15)
           brr(1, 22) = arr(7, 16)
           brr(1, 23) = arr(7, 17)
           brr(1, 24) = arr(7, 18)
           brr(1, 25) = arr(7, 19)
           brr(1, 26) = arr(7, 20)
           brr(1, 27) = arr(7, 21)
           brr(1, 28) = arr(7, 22)
           brr(1, 29) = arr(7, 23)

           brr(1, 30) = arr(7, 24)
           brr(1, 31) = arr(7, 25)
           brr(1, 32) = arr(7, 26)
           brr(1, 33) = arr(7, 27)
           brr(1, 34) = arr(7, 28)
           brr(1, 35) = arr(7, 29)
           brr(1, 36) = arr(7, 30)
           brr(1, 37) = arr(7, 31)

           brr(1, 38) = arr(7, 32)
           brr(1, 39) = arr(7, 33)
           brr(1, 40) = arr(7, 34)
           brr(1, 41) = arr(7, 35)
           brr(1, 42) = arr(7, 36)
           brr(1, 43) = arr(7, 37)
           brr(1, 44) = arr(11, 8)
           brr(1, 45) = arr(11, 11)
           brr(1, 46) = arr(11, 12)
           brr(1, 47) = arr(11, 13)
           brr(1, 48) = arr(11, 14)
           brr(1, 49) = arr(11, 15)
           brr(1, 50) = arr(17, 6)
           brr(1, 51) = arr(17, 7)
           brr(1, 52) = arr(17, 8)
           brr(1, 53) = arr(17, 9)
           brr(1, 54) = arr(17, 10)
           brr(1, 55) = arr(17, 11)
           brr(1, 56) = arr(17, 28)









            Set mbrng = ThisWorkbook.Worksheets("汇总").[a65536].End(xlUp).Offset(1, 0)
            mbrng.Resize(UBound(brr), 50) = brr
            Application.CutCopyMode = False
            Erase brr
        End With
     End With
     wb.Close False
  End If
  myname = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "汇总完成"
End Sub