SUM Several Workbooks with Worksheets into one

[marcoh]

HI Forum

I've got a question on how to create a summary workbook

Here is what I have.
- about 15 files, all with 20 sheets
- all with different content, but exactly the same structure

Here is what I need:
- 1 file with the same 20 sheets and the same structure but all the cells are summarized

example
file1.xlsx - sheet1
[TABLE="width: 500"]
<tbody>[TR]
[TD]2[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]5[/TD]
[/TR]
</tbody>[/TABLE]


file2.xlsx - sheet1
[TABLE="width: 500"]
<tbody>[TR]
[TD]6[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


The result shoul be
result.xlsx - sheet1
[TABLE="width: 500"]
<tbody>[TR]
[TD]8[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]14[/TD]
[/TR]
</tbody>[/TABLE]


just i a very bigger picture of 20 sheets

the rage of value is roughly A2:G35 and I've got 15 files

Can anyboby help me with that?

Thanks a lot

 

[actjfc]

It can be done using one Pivot Table combining multiple tables as input. If you do not know much about them, take a look at some videos on youtube, for example, https://www.youtube.com/watch?v=Tu6SGU-rK6c. I hope it helps!

 

[ravishankar]

Hi
create a file named marcoh.xlsm containing sheet1 and 20 other sheet names and save it in the folder containing 15 files.
paste the following macro codes

Sub collate_excelfiles()
Dim a As Long, C As String
Dim f As String, b As Integer, x As Integer, y As Integer


Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
f = Dir(Cells(1, 2) & "*.xls*")
Cells(2, 1).Select
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop


MsgBox "Listing is complete"
x = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox "there are " & x - 1 & " files"
For a = 2 To x
Workbooks("marcoh.xlsm").Sheets("sheet1").Activate
Workbooks.Open Filename:=Cells(1, 2) & Cells(a, 1)
For b = 1 To 8 'change to actual number of sheets
C = Choose(b, "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8") 'add sheet names separated by commas
Sheets(C).UsedRange.Copy
Windows("marcoh.xlsm").Activate
Sheets(C).Range("G1").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Z = Sheets("Sheet1").Cells(a, 1)
Windows(Z).Activate
Next b
Next a

MsgBox "complete"
End Sub

Change sheet names and sheet number suitably and run the macro. If there are no snags, it will collate data into respective sheets and add them automatically.
Ravi shankar

 

[marcoh]

I solved it.

Consolidate Sub loops through every sheet in the file

The Function Consofiles creates an Array with all the filenames of the specified path and creates Consolidation

I later inserted a Select case inside Consolidate for the Sheets which have a different range.

[COLOR=#333333][FONT=Monaco]Sub Consolidate()[/FONT][/COLOR]

[COLOR=#333333][FONT=Monaco]Dim wks As Worksheet, strName As String[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]Dim CalcRange As Variant[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]dim strPath as String[/FONT][/COLOR]

[COLOR=#333333][FONT=Monaco]strPath = "C:\PATH\TO\XLSFILES\"[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]For Each wks In Worksheets[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]    strName = wks.Name[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]    [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]    Sheets(strName).Select[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       Cells.Select[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       Selection.ClearContents[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       Range("A1").Select[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       CalcRange = Consofiles(strPath, strName & "'!R3C1:R40C7")[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       Selection.Consolidate Sources:=CalcRange, Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       Cells.Select[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       Cells.EntireColumn.AutoFit[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]    [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]Next[/FONT][/COLOR]

[COLOR=#333333][FONT=Monaco]End Sub[/FONT][/COLOR]


[COLOR=#333333][FONT=Monaco]'====================================================[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]Public Function Consofiles(strPath As String, CellRange As String) As Variant[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]Dim strConso As Variant[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]Dim StrFile As String[/FONT][/COLOR]

[COLOR=#333333][FONT=Monaco]Dim i As Integer[/FONT][/COLOR]

[COLOR=#333333][FONT=Monaco]ReDim strConso(1 To 1)[/FONT][/COLOR]

[COLOR=#333333][FONT=Monaco]   StrFile = Dir(strPath & "*xls*", vbDirectory)[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]   Do While Len(StrFile) > 0[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       i = i + 1[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       ReDim Preserve strConso(1 To i)[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]             strConso(i) = "'" & strPath & "[" & StrFile & "]" & CellRange[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]       StrFile = Dir[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]      [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]   Loop[/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]   [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]   [/FONT][/COLOR]
[COLOR=#333333][FONT=Monaco]Consofiles = strConso[/FONT][/COLOR]

[COLOR=#333333][FONT=Monaco]End Function[/FONT][/COLOR]