从一个文件夹中的所有xlsx表中取数据整合

文件夹中有多个工作簿：

工作簿的格式：

实现代码：

Sub 周()
    Dim str As String
    Dim path As String
    Dim thisBookPath As String
    Dim wb As Workbook
    Dim i, count As Long
    Dim num, num1, num2 As Double
    
    i = 1
    thisBookPath = ActiveWorkbook.path
    
    
    Application.ScreenUpdating = False
    
    path = InputBox("请输入文件路径")
    str = Dir(path & "\*.xlsx")
    
    Do While str <> ""
        Set wb = Workbooks.Open(thisBookPath & "\" & str)
        With Workbooks(str).ActiveSheet
            count = .Range("D65536").End(xlUp).Row - 2
            .Range("D" & count + 3).Select
            Selection.FormulaR1C1 = "=SUM(R[" & -count & "]C:R[-1]C)"
            num1 = .Range("D" & count + 3).Value
            .Range("D" & count + 3).Value = ""
            

            .Range("E" & count + 3).Select
            Selection.FormulaR1C1 = "=SUM(R[" & -count & "]C:R[-1]C)"
            num2 = .Range("E" & count + 3).Value
            .Range("E" & count + 3).Value = ""
            num = num1 + num2
            ThisWorkbook.Worksheets(1).Cells(i, 1).Value = str
            ThisWorkbook.Worksheets(1).Cells(i, 2).Value = num
            i = i + 1
            wb.Close False
        End With
        
        str = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "OK"
    
End Sub

最终效果：