文件夹中有多个工作簿：

工作簿的格式：

实现代码：

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

最终效果：