最后一行添加合计，给G列和H列求和。

ruhong18

批量将文件夹内所有文件的所有工作簿（有数据的）最后一行添加【合计：对G列和H列求和。】

longwin

Sub test()
Application.ScreenUpdating = False
fname = Dir(ThisWorkbook.Path & "\文件夹\*.xls")
Do While fname <> ""
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\文件夹\" & fname)
    For Each sh In wb.Sheets()
        lastrow = sh.[G1].End(xlDown).Row
        sh.Cells(lastrow + 1, 1) = "合计："
        sh.Cells(lastrow + 1, "G") = WorksheetFunction.Sum(sh.Range("G2:G" & lastrow))
        sh.Cells(lastrow + 1, "H") = WorksheetFunction.Sum(sh.Range("H2:H" & lastrow))
    Next
    wb.Close savechanges:=True
    fname = Dir
Loop
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

Qs18

Sub qs() '多工作簿多工作表最后一行添加合计
    Dim fso As Object
    Dim folderPath As String
    Dim file As Object
    Dim wb As Workbook, xb As Workbook, sht As Worksheet
Set wb = ThisWorkbook

ph = ThisWorkbook.Path & "\文件夹"

    ' 创建FileSystemObject对象
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 设置要遍历的文件夹路径
    folderPath = ph
    ' 检查文件夹是否存在
    If fso.FolderExists(folderPath) Then
        ' 获取文件夹
        Set folder = fso.GetFolder(folderPath)
        ' 遍历文件夹中的所有文件
        For Each file In folder.Files
            ' 检查文件是否是Excel文件
            If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Or _
               LCase(fso.GetExtensionName(file.Name)) = "xls" Then
                ' 这里是文件名
'                Debug.Print file.Name
                Set xb = Workbooks.Open(ph & "\" & file.Name, 0)
               
                For Each sht In xb.Sheets
                    rw = sht.Cells(Rows.Count, "b").End(3).Row
                    sm1 = 0: sm2 = 0
                    arr = sht.Range("a1:h" & rw).Value
                    sm1 = Application.Sum(Application.Index(arr, 0, 7))
                    sm2 = Application.Sum(Application.Index(arr, 0, 8))
                    
                    sht.Range("g" & rw + 1).Value = sm1
                    sht.Range("h" & rw + 1).Value = sm2
                Erase arr
                Next
            End If
        xb.Close (1)
        Next file
    Else
        MsgBox "指定的文件夹不存在。"
    End If
    ' 清理
    Set fso = Nothing: Set wb = Nothing
    Set folder = Nothing: Set xb = Nothing
    Application.ScreenUpdating = True
End Sub

Qs18

多工作簿多工作表最后一行添加合计给G列和H列求和

杨建营

参与一下。