Sum several individual cells from several Workbooks into one Workbook

A

aylafan

New Member
Joined
Apr 13, 2011
Messages
20
I'm trying to sum several individual cells from several Workbooks into one Workbook. I need it to be in VBA because using Consolidate Data doesn't seem to work with text (creates blank cells) and using =SUM([48800.xlsm]Summary!H5,[49900.xlsm]Summary!H5) doesn't work that well with several hundred Workbooks.

I'm trying to find a VBA code that will loop through one folder with any Workbooks named *.xls or *.xlsm and grab several specific cells (ex. H5, I5, J5, H6, I6, J6) from (Sheet: Summary) and sum each cell to one Workbook with (Sheet: Summary) to the same cell locations (H5, I5, J5, H6, I6, J6) because it will have the same layout.

I found this code, but I don't know much about VBA to modify it to my needs. I will truly appreciate anyone's help and time.

Code: 
Sub total()
Dim a As Integer, x As Integer
Dim f As String
Cells(2, 1).Select
f = Dir("d:\test\" & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
Cells(1, 2) = ""
x = Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To x
Cells(1, 1) = "='d:\test\[" & Cells(a, 1) & "]Summary'!B7"
Cells(1, 2) = Cells(1, 2) + Cells(1, 1)
Next a
MsgBox " The total of B7 from " & x - 1 & "  files is " & Cells(1, 2)
End Sub

-------------------------------------
I use Windows 7 64-bit and Excel 2007
 
Last edited:

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
Hi,

I don't know of a tidier way to do this.
I'm sure someone else does?
The code you posted would take me a long time to fathom

This will extract values from cells H, I and J 5 and 6 from all the files in a folder and sum them in same cells in the workbook containing the macro.

Code: 
Sub Sum_Cells()
'Display Open Dialog to select file directory
  filenames = Application.GetOpenFilename("Excel Files (*.xls*)," & _
    "*.xls*", 1, "Select Files", "Open", False)
 
'If the user cancels file selection then exit
    If TypeName(filenames) = "Boolean" Then
        Exit Sub
     End If
 
'Set xls as SourceFile
        SourceFile = Dir("*.xls*")
           Do While SourceFile <> ""
 
    Workbooks.Open (SourceFile)
    Set XLSFile = ActiveWorkbook
 
    Worksheets("Summary").Select
 
    CurrValue1 = Range("H5").Value
    CurrValue2 = Range("I5").Value
    CurrValue3 = Range("J5").Value
    CurrValue4 = Range("H6").Value
    CurrValue5 = Range("I6").Value
    CurrValue6 = Range("J6").Value
 
    TotalValue1 = ThisWorkbook.Sheets("Summary").Range("H5").Value
    TotalValue2 = ThisWorkbook.Sheets("Summary").Range("I5").Value
    TotalValue3 = ThisWorkbook.Sheets("Summary").Range("J5").Value
    TotalValue4 = ThisWorkbook.Sheets("Summary").Range("H6").Value
    TotalValue5 = ThisWorkbook.Sheets("Summary").Range("I6").Value
    TotalValue6 = ThisWorkbook.Sheets("Summary").Range("J6").Value
 
    ThisWorkbook.Sheets("Summary").Range("H5").Value = TotalValue1 + CurrValue1
    ThisWorkbook.Sheets("Summary").Range("I5").Value = TotalValue2 + CurrValue2
    ThisWorkbook.Sheets("Summary").Range("J5").Value = TotalValue3 + CurrValue3
    ThisWorkbook.Sheets("Summary").Range("H6").Value = TotalValue4 + CurrValue4
    ThisWorkbook.Sheets("Summary").Range("I6").Value = TotalValue5 + CurrValue5
    ThisWorkbook.Sheets("Summary").Range("J6").Value = TotalValue6 + CurrValue6
 
 Windows.Application.CutCopyMode = False
 XLSFile.Close False
   SourceFile = Dir
  Loop
 
End Sub
 
Upvote 0
Thank you so much daverunt!

The code works perfectly and it sums the specific cells from several workbooks into one workbook.

The only bug I am getting is a "Run-time error '1004': Method 'Open' of object 'Workbooks' failed" if I open the Master Summary Workbook in the same folder, but moving it out of the folder solves the problem.

I appreciate your time and effort on helping me solve this problem.

Now, I will be able to sum several hundred Purchase Order Summary Workbooks into one Workbook.
 
Upvote 0
Ok,

here's a slightly less cluttered version. I still can't figure out a better way to achieve this though - beyond me at the moment.

You can put the Master Summary Workbook back in the same folder. In the code enter the full name including extension where shown in red. This will prevent the file being opened.

Code: 
Sub Sum_Cells()
'Display Open Dialog to select file directory
filenames = Application.GetOpenFilename("Excel Files (*.xls*)," & _
"*.xls*", 1, "Select Files", "Open", False)
 
'If the user cancels file selection then exit
If TypeName(filenames) = "Boolean" Then
Exit Sub
End If
 
'Set xls as SourceFile
SourceFile = Dir("*.xls*")
Do While SourceFile <> ""
 
 
If Not (SourceFile) = "[COLOR=red][B]Master Summary Worksheet.xls[/B][/COLOR]" Then
Workbooks.Open (SourceFile)
Set XLSFile = ActiveWorkbook
 
CurrValue1 = Range("H5").Value
CurrValue2 = Range("I5").Value
CurrValue3 = Range("J5").Value
CurrValue4 = Range("H6").Value
CurrValue5 = Range("I6").Value
CurrValue6 = Range("J6").Value
 
ThisWorkbook.Activate
 
TotalValue1 = Range("H5").Value
TotalValue2 = Range("I5").Value
TotalValue3 = Range("J5").Value
TotalValue4 = Range("H6").Value
TotalValue5 = Range("I6").Value
TotalValue6 = Range("J6").Value
 
Range("H5").Value = TotalValue1 + CurrValue1
Range("I5").Value = TotalValue2 + CurrValue2
Range("J5").Value = TotalValue3 + CurrValue3
Range("H6").Value = TotalValue4 + CurrValue4
Range("I6").Value = TotalValue5 + CurrValue5
Range("J6").Value = TotalValue6 + CurrValue6
 
Windows.Application.CutCopyMode = False
XLSFile.Close False
 
End If
SourceFile = Dir
Loop
 
End Sub
 
Upvote 0
Forgot to add the Worksheet selection to the last post


Code: 
Sub Sum_Cells()
'Display Open Dialog to select file directory
  filenames = Application.GetOpenFilename("Excel Files (*.xls*)," & _
    "*.xls*", 1, "Select Files", "Open", False)
 
'If the user cancels file selection then exit
    If TypeName(filenames) = "Boolean" Then
        Exit Sub
     End If
 
'Set xls as SourceFile
        SourceFile = Dir("*.xls*")
           Do While SourceFile <> ""
 
 
 If Not (SourceFile) = "Master Workbook Summary.xls" Then
    Workbooks.Open (SourceFile)
    Set XLSFile = ActiveWorkbook
 
[COLOR=red]Worksheets("Summary").Select[/COLOR]
       
    CurrValue1 = Range("H5").Value
    CurrValue2 = Range("I5").Value
    CurrValue3 = Range("J5").Value
    CurrValue4 = Range("H6").Value
    CurrValue5 = Range("I6").Value
    CurrValue6 = Range("J6").Value
 
 ThisWorkbook.Activate
 [COLOR=red]Worksheets("Summary").Select[/COLOR]
    
    TotalValue1 = Range("H5").Value
    TotalValue2 = Range("I5").Value
    TotalValue3 = Range("J5").Value
    TotalValue4 = Range("H6").Value
    TotalValue5 = Range("I6").Value
    TotalValue6 = Range("J6").Value
 
    Range("H5").Value = TotalValue1 + CurrValue1
    Range("I5").Value = TotalValue2 + CurrValue2
    Range("J5").Value = TotalValue3 + CurrValue3
    Range("H6").Value = TotalValue4 + CurrValue4
    Range("I6").Value = TotalValue5 + CurrValue5
    Range("J6").Value = TotalValue6 + CurrValue6
 
 Windows.Application.CutCopyMode = False
 XLSFile.Close False
 
 End If
   SourceFile = Dir
  Loop
 
End Sub
 
Upvote 0
I'm getting a "Run-time error '13': Type mismatch with the new code after it sums everything to the Master Worksheet in the same folder.

Currently, double checking to see if I mistyped any numbers in the code, but they all seem correct so far.

Do you know what this error is? Thanks.

Updated: Nevermind, it works perfectly now. I just forgot to put in Worksheets("Summary").Select

daverunt - Thank you so much for helping me through this. This Excel project for my company has been stressing me out.
 
Last edited:
Upvote 0
Hi,
No problem.

try this - I needed to tidy up that repetitive code :)

Code: 
Sub Sum_CellsTwo()
'Display Open Dialog to select file directory
  filenames = Application.GetOpenFilename("Excel Files (*.xls*)," & _
    "*.xls*", 1, "Select Files", "Open", False)
 
'If the user cancels file selection then exit
    If TypeName(filenames) = "Boolean" Then
        Exit Sub
     End If
 
'Set xls as SourceFile
        SourceFile = Dir("*.xls*")
           Do While SourceFile <> ""
 
 If Not (SourceFile) = "[COLOR=red]Master Workbook Summary.xls[/COLOR]" Then
    Workbooks.Open (SourceFile)
    Set XLSFile = ActiveWorkbook
    Worksheets("Summary").Select
    Set Rng = Sheets("Summary").Range("H5:J6")
 
    For Each Cell In Rng
 
    x = Cell.Address(0, 0)
    CurrValue = Cell.Value
 
 ThisWorkbook.Activate
 Worksheets("Summary").Select
 
    TotalValue = Range(x).Value
    Range(x).Value = TotalValue + CurrValue
 
 Next
 Windows.Application.CutCopyMode = False
 XLSFile.Close False
 
 End If
   SourceFile = Dir
  Loop
 
End Sub
 
Last edited:
Upvote 0
Thanks, I'll try your new code. Currently, the previous code works fine, but it took forever to implement.

Would using Set Rng = Sheets("Summary").Range("H5:J6")
with several different ranges work the same way or is there something new I need to add to your code?

Code: 
Sub SumCells()
Application.ScreenUpdating = False
'Display Open Dialog to select file directory
filenames = Application.GetOpenFilename("Excel Files (*.xls*)," & _
"*.xls*", 1, "Select Files", "Open", False)
 
'If the user cancels file selection then exit
If TypeName(filenames) = "Boolean" Then
Exit Sub
End If
 
'Set xls as SourceFile
SourceFile = Dir("*.xls*")
Do While SourceFile <> ""
 
If Not (SourceFile) = "Master Summary.xlsm" Then
Workbooks.Open (SourceFile)
Set XLSFile = ActiveWorkbook
Worksheets("Summary").Select
'Site Section
    CurrValue1 = Range("H5").Value
    CurrValue2 = Range("I5").Value
    CurrValue3 = Range("J5").Value
    CurrValue4 = Range("H6").Value
    CurrValue5 = Range("I6").Value
    CurrValue6 = Range("J6").Value
    CurrValue7 = Range("H7").Value
    CurrValue8 = Range("I7").Value
    CurrValue9 = Range("J7").Value
    CurrValue10 = Range("H8").Value
    CurrValue11 = Range("I8").Value
    CurrValue12 = Range("J8").Value
    CurrValue13 = Range("H9").Value
    CurrValue14 = Range("I9").Value
    CurrValue15 = Range("J9").Value
    CurrValue16 = Range("H10").Value
    CurrValue17 = Range("I10").Value
    CurrValue18 = Range("J10").Value
    CurrValue19 = Range("H11").Value
    CurrValue20 = Range("I11").Value
    CurrValue21 = Range("J11").Value
 
'Summary Section
    CurrValue22 = Range("B28").Value
    CurrValue23 = Range("B29").Value
    CurrValue24 = Range("B30").Value
    CurrValue25 = Range("B31").Value
 
    CurrValue26 = Range("F28").Value
    CurrValue27 = Range("F29").Value
    CurrValue28 = Range("F30").Value
 
    CurrValue29 = Range("F33").Value
    CurrValue30 = Range("F34").Value
 
    CurrValue31 = Range("J35").Value
 
'Sub-Categories Section
    CurrValue32 = Range("B41").Value
    CurrValue33 = Range("B42").Value
    CurrValue34 = Range("B43").Value
    CurrValue35 = Range("B44").Value
 
    CurrValue36 = Range("B50").Value
    CurrValue37 = Range("B51").Value
    CurrValue38 = Range("B52").Value
    CurrValue39 = Range("B53").Value
    CurrValue40 = Range("B54").Value
    CurrValue41 = Range("B55").Value
    CurrValue42 = Range("B56").Value
    CurrValue43 = Range("B57").Value
 
    CurrValue44 = Range("G41").Value
    CurrValue45 = Range("G42").Value
    CurrValue46 = Range("G43").Value
    CurrValue47 = Range("G44").Value
    CurrValue48 = Range("G45").Value
    CurrValue49 = Range("G46").Value
 
    CurrValue50 = Range("G50").Value
    CurrValue51 = Range("G51").Value
    CurrValue52 = Range("G52").Value
    CurrValue53 = Range("G53").Value
    CurrValue54 = Range("G54").Value
    CurrValue55 = Range("G55").Value
    CurrValue56 = Range("G56").Value
    CurrValue57 = Range("G57").Value
    CurrValue58 = Range("G58").Value
    CurrValue59 = Range("G59").Value
    CurrValue60 = Range("G60").Value
 
    CurrValue61 = Range("J61").Value
 
ThisWorkbook.Activate
Worksheets("Summary").Select
'Site Section
    TotalValue1 = Range("H5").Value
    TotalValue2 = Range("I5").Value
    TotalValue3 = Range("J5").Value
    TotalValue4 = Range("H6").Value
    TotalValue5 = Range("I6").Value
    TotalValue6 = Range("J6").Value
    TotalValue7 = Range("H7").Value
    TotalValue8 = Range("I7").Value
    TotalValue9 = Range("J7").Value
    TotalValue10 = Range("H8").Value
    TotalValue11 = Range("I8").Value
    TotalValue12 = Range("J8").Value
    TotalValue13 = Range("H9").Value
    TotalValue14 = Range("I9").Value
    TotalValue15 = Range("J9").Value
    TotalValue16 = Range("H10").Value
    TotalValue17 = Range("I10").Value
    TotalValue18 = Range("J10").Value
    TotalValue19 = Range("H11").Value
    TotalValue20 = Range("I11").Value
    TotalValue21 = Range("J11").Value
 
'Summary Section
    TotalValue22 = Range("B28").Value
    TotalValue23 = Range("B29").Value
    TotalValue24 = Range("B30").Value
    TotalValue25 = Range("B31").Value
 
    TotalValue26 = Range("F28").Value
    TotalValue27 = Range("F29").Value
    TotalValue28 = Range("F30").Value
 
    TotalValue29 = Range("F33").Value
    TotalValue30 = Range("F34").Value
 
    TotalValue31 = Range("J35").Value
 
 'Sub-categories Section
    TotalValue32 = Range("B41").Value
    TotalValue33 = Range("B42").Value
    TotalValue34 = Range("B43").Value
    TotalValue35 = Range("B44").Value
 
    TotalValue36 = Range("B50").Value
    TotalValue37 = Range("B51").Value
    TotalValue38 = Range("B52").Value
    TotalValue39 = Range("B53").Value
    TotalValue40 = Range("B54").Value
    TotalValue41 = Range("B55").Value
    TotalValue42 = Range("B56").Value
    TotalValue43 = Range("B57").Value
 
    TotalValue44 = Range("G41").Value
    TotalValue45 = Range("G42").Value
    TotalValue46 = Range("G43").Value
    TotalValue47 = Range("G44").Value
    TotalValue48 = Range("G45").Value
    TotalValue49 = Range("G46").Value
 
    TotalValue50 = Range("G50").Value
    TotalValue51 = Range("G51").Value
    TotalValue52 = Range("G52").Value
    TotalValue53 = Range("G53").Value
    TotalValue54 = Range("G54").Value
    TotalValue55 = Range("G55").Value
    TotalValue56 = Range("G56").Value
    TotalValue57 = Range("G57").Value
    TotalValue58 = Range("G58").Value
    TotalValue59 = Range("G59").Value
    TotalValue60 = Range("G60").Value
 
    TotalValue61 = Range("J61").Value
 
 'Site Section
    Range("H5").Value = TotalValue1 + CurrValue1
    Range("I5").Value = TotalValue2 + CurrValue2
    Range("J5").Value = TotalValue3 + CurrValue3
    Range("H6").Value = TotalValue4 + CurrValue4
    Range("I6").Value = TotalValue5 + CurrValue5
    Range("J6").Value = TotalValue6 + CurrValue6
    Range("H7").Value = TotalValue7 + CurrValue7
    Range("I7").Value = TotalValue8 + CurrValue8
    Range("J7").Value = TotalValue9 + CurrValue9
    Range("H8").Value = TotalValue10 + CurrValue10
    Range("I8").Value = TotalValue11 + CurrValue11
    Range("J8").Value = TotalValue12 + CurrValue12
    Range("H9").Value = TotalValue13 + CurrValue13
    Range("I9").Value = TotalValue14 + CurrValue14
    Range("J9").Value = TotalValue15 + CurrValue15
    Range("H10").Value = TotalValue16 + CurrValue16
    Range("I10").Value = TotalValue17 + CurrValue17
    Range("J10").Value = TotalValue18 + CurrValue18
    Range("H11").Value = TotalValue19 + CurrValue19
    Range("I11").Value = TotalValue20 + CurrValue20
    Range("J11").Value = TotalValue21 + CurrValue21
 
'Summary Section
    Range("B28").Value = TotalValue22 + CurrValue22
    Range("B29").Value = TotalValue23 + CurrValue23
    Range("B30").Value = TotalValue24 + CurrValue24
    Range("B31").Value = TotalValue25 + CurrValue25
 
    Range("F28").Value = TotalValue26 + CurrValue26
    Range("F29").Value = TotalValue27 + CurrValue27
    Range("F30").Value = TotalValue28 + CurrValue28
 
    Range("F33").Value = TotalValue29 + CurrValue29
    Range("F34").Value = TotalValue30 + CurrValue30
 
    Range("J35").Value = TotalValue31 + CurrValue31
 
'Sub-categories Section
    Range("B41").Value = TotalValue32 + CurrValue32
    Range("B42").Value = TotalValue33 + CurrValue33
    Range("B43").Value = TotalValue34 + CurrValue34
    Range("B44").Value = TotalValue35 + CurrValue35
 
    Range("B50").Value = TotalValue36 + CurrValue36
    Range("B51").Value = TotalValue37 + CurrValue37
    Range("B52").Value = TotalValue38 + CurrValue38
    Range("B53").Value = TotalValue39 + CurrValue39
    Range("B54").Value = TotalValue40 + CurrValue40
    Range("B55").Value = TotalValue41 + CurrValue41
    Range("B56").Value = TotalValue42 + CurrValue42
    Range("B57").Value = TotalValue43 + CurrValue43
 
    Range("G41").Value = TotalValue44 + CurrValue44
    Range("G42").Value = TotalValue45 + CurrValue45
    Range("G43").Value = TotalValue46 + CurrValue46
    Range("G44").Value = TotalValue47 + CurrValue47
    Range("G45").Value = TotalValue48 + CurrValue48
    Range("G46").Value = TotalValue49 + CurrValue49
 
    Range("G50").Value = TotalValue50 + CurrValue50
    Range("G51").Value = TotalValue51 + CurrValue51
    Range("G52").Value = TotalValue52 + CurrValue52
    Range("G53").Value = TotalValue53 + CurrValue53
    Range("G54").Value = TotalValue54 + CurrValue54
    Range("G55").Value = TotalValue55 + CurrValue55
    Range("G56").Value = TotalValue56 + CurrValue56
    Range("G57").Value = TotalValue57 + CurrValue57
    Range("G58").Value = TotalValue58 + CurrValue58
    Range("G59").Value = TotalValue59 + CurrValue59
    Range("G60").Value = TotalValue60 + CurrValue60
 
    Range("J61").Value = TotalValue61 + CurrValue61
 
Windows.Application.CutCopyMode = False
XLSFile.Close False
 
End If
SourceFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
For example: using Set Rng = Sheets("Summary").Range("H5:J11") works perfectly fine in your new code.

How would I use the above range combined with these other ranges?
Set Rng = Sheets("Summary").Range("B28:B31")
Set Rng = Sheets("Summary").Range("F28:F30")
Set Rng = Sheets("Summary").Range("F33:F34")
Set Rng = Sheets("Summary").Range("J35:J35")
Set Rng = Sheets("Summary").Range("B41:B44")
Set Rng = Sheets("Summary").Range("B50:B57")
Set Rng = Sheets("Summary").Range("G41:G46")
Set Rng = Sheets("Summary").Range("G50:G60")
Set Rng = Sheets("Summary").Range("J61:J61")
 
Upvote 0
I figured it out. All credit goes to daverunt.

Here is the final code:
Code: 
Sub SumCells()
Application.ScreenUpdating = False
    'Display Open Dialog to select file directory
filenames = Application.GetOpenFilename("Excel Files (*.xls*)," & _
"*.xls*", 1, "Select Files", "Open", False)
 
'If the user cancels file selection then exit
If TypeName(filenames) = "Boolean" Then
Exit Sub
End If
 
'Set xls as SourceFile
SourceFile = Dir("*.xls*")
Do While SourceFile <> ""
 
If Not (SourceFile) = "Master Summary.xlsm" Then
Workbooks.Open (SourceFile)
Set XLSFile = ActiveWorkbook
Worksheets("Summary").Select
    Set Rng = Sheets("Summary").Range("H5:J11,B28:B31,F28:F30,F33:F34,J35:J35,B41:B44,B50:B57,G41:G46,G50:G60,J61:J61")
    For Each Cell In Rng
 
    x = Cell.Address(0, 0)
    CurrValue = Cell.Value
 
 ThisWorkbook.Activate
 Worksheets("Summary").Select
 
    TotalValue = Range(x).Value
    Range(x).Value = TotalValue + CurrValue
 
 Next
 Windows.Application.CutCopyMode = False
 XLSFile.Close False
 
 End If
 SourceFile = Dir
  Loop
Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
VBA to extract info from one tab in several workbooks
Replies
8
Views
305
elpepe1970
E
A
  • Question Question
How do you write the formula to check for duplicates from an entire range A2:J5?
Replies
8
Views
292
arthurz11
A
R
  • Solved
VBA - Combine worksheets from multiple workbooks
Replies
5
Views
357
rachel06
R
R
  • Question Question
Help to sum all cells above until blank cell
Replies
3
Views
690
RemyMoo
R
Y
  • Solved
Wrong Copy Data from Several Excel file
Replies
8
Views
348
yamixas
Y

Forum statistics

Threads
1,224,570
Messages
6,179,611
Members
452,931
Latest member
The Monk

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top