1
votes
  • I have 50 workbooks. Each has 3 worksheets.
  • I have a value in each of these sheets from cells A1 to N1.
  • I want to sum up all the values in a single workbook (in 3 worksheets respectively). (i.e. A1 of sheet1 workbook1 + A1 of sheet1 workbook2 +.....+ A1 of sheet1 workbook50 = A1 of sheet1 MacroWorkbook.

Similarly B1 of sheet1 workbook1 + B1 of sheet1 workbook2 +.....+ B1 of sheet1 workbook50 = B1 of sheet1 MacroWorkbook. For 3 sheets and say 50 workbooks.

I would prefer open file location instead of selecting from a directory.


With the help of different forums, I have tried getting the sum from multiple workbooks from sheet1:

Sub SUM_Workbooks()
    Dim FileNameXls As Variant
    Dim i As Integer
    Dim wb As Workbook
    FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", MultiSelect:=True)
    If Not IsArray(FileNameXls) Then Exit Sub
    Application.ScreenUpdating = False
    For i = LBound(FileNameXls) To UBound(FileNameXls)
        Set wb = Workbooks.Open(FileNameXls(i))
        wb.Sheets(1).Range("A1:N1").Copy
        ThisWorkbook.Sheets(1).Range("A1:N1").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=False
        Application.CutCopyMode = False
        wb.Close SaveChanges:=False
        Next i
    Application.ScreenUpdating = True
End Sub

I would want to extend this for 3 sheets. Help would be much appreciated as I'm no expert in VBA. Thanks!

1
I have tried working it out sum of cells from multiple workbooks for 1 sheet. I would want to get the sum from 3 worksheets.user3477709
how do you want to paste values? in first row for first workbook, in second row for second workbook and so on? Or sum all values from All workbooks id paste result in A1:N1?Dmitry Pavliv
I want to sum all values and paste results in A1:N1.user3477709

1 Answers

1
votes

If you want to sum values from all workbooks (from each worksheet A1:N1) and paste result in A1:N1 of thisWorkbook, use this one:

Sub SUM_Workbooks()
    Dim FileNameXls, f
    Dim wb As Workbook, i As Integer

    FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", MultiSelect:=True)

    If Not IsArray(FileNameXls) Then Exit Sub

    Application.ScreenUpdating = False

    For Each f In FileNameXls
        Set wb = Workbooks.Open(f)
        For i = 1 To 3
            wb.Worksheets(i).Range("A1:N1").Copy
            ThisWorkbook.Sheets(i).Range("A1:N1").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=False
        Next i
        wb.Close SaveChanges:=False
    Next f

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub