On May 31, 9:26*pm, Joel wrote:
I'm now using PasteSpecial to perfrom the adding which simplifies the code.. *
The Read data from all the workbooks can be protected without any problems.. *
the All total book need to be unprotected. *Can add this code if necessary.

Sub totalbooks()

Folder = "C:\Report"
AllFileName = "Alltotals"
LenAll = Len(AllFileName)

'Open All total book
Set Allbk = Workbooks.Open(Filename:=Folder & "\" _
* *& AllFileName & ".xls")
Set AllSht = Allbk.Sheets(2)

'Set AllShtle to total range
Set AllTotalRange = AllSht.Range("B6:S61")
'set totals to zero
AllTotalRange.Value = 0

FName = Dir(Folder & "\*.xls")
Do While FName < ""
* *'Don't open allmonth files
* *If Left(UCase(FName), LenAll) < UCase(AllFileName) Then
* * * Set Reportbk = Workbooks.Open(Filename:=Folder & "\" & FName)
* * * Set Report_T_Sht = Reportbk.Sheets("Total")

* * * Set TotalRange = Report_T_Sht.Range("B6:S61")

* * * 'copy and add data to total workbook
* * * TotalRange.Copy
* * * AllTotalRange.PasteSpecial _
* * * * *Operation:=xlAdd

* * * Reportbk.Close
* *End If
* *FName = Dir()
Loop

bkMonth = AllSht.Range("R1")
bkYear = AllSht.Range("S1")
Allbk.SaveAs Filename:=Folder & "\" & AllFileName & bkMonth & bkYear
Allbk.Close SaveAs:=False
End Sub



" wrote:
On May 30, 11:56 pm, Joel wrote:
I re-read you instruction and I think I got it right this time. *I used a sum
formula to sum all the sheets for each of the cells in the area B6:S61 like
this

=Sum(Sheet1:Rheet31!R6C2)

I'm using R1C1 addressing, but it gets translated to be A1 addressing. *If
the sheet name are not 1 and 31 then change the instruction like this

=Sum(alpha:zeta!R6C2)

if there are spaces then we need to add single quotes

=Sum('alpha 1:zeta 4'!R6C2)

Sub totalbooks()

Folder = "C:\Report"
AllFileName = "Alltotals"
LenAll = Len(AllFileName)

'Open All total book
Set Allbk = Workbooks.Open(Filename:=Folder & "\" _
* *& AllFileName & ".xls")
Set AllSht = Allbk.Sheets(2)
'find last row of in column A
LastRow = AllSht.Range("A" & Rows.Count).End(xlUp).Row
'Newrow is row where report total is put
NewRow = LastRow
FName = Dir(Folder & "\*.xls")
Do While FName < ""
* *'Don't open allmonth files
* *If Left(UCase(FName), LenAll) < UCase(AllFileName) Then
* * * Set Reportbk = Workbooks.Open(Filename:=Folder & "\" & FName)
* * * Set Report_T_Sht = Reportbk.Sheets("Total")

* * * For RowCount = 6 To 60
* * * * *For ColCount = sht.Range("B6").Column To sht.Range("S6").Column
* * * * * * Report_T_Sht.Cells(RowCount, ColCount).FormulaR1C1 = _
* * * * * * * *"=Sheet1:Sheet31!R" & RowCount & "C" & ColCount
* * * * *Next ColCount
* * * Next RowCount
* * * Set TotalRange = Report_T_Sht.Range("B6:S60")
* * * Total = WorksheetFunction.Sum(TotalRange)
* * * NewRow = NewRow + 1
* * * AllSht.Range("A" & NewRow) = FName
* * * AllSht.Range("B" & NewRow) = Total
* * * Reportbk.Close
* *End If
* *FName = Dir()
Loop
'add total to All total book as a formula
AllSht.Range("A" & (NewRow + 2)) = "GRAND TOTL"
AllSht.Range("B" & (NewRow + 2)).Formula = _
* *"=SUM(B" & (LastRow + 1) & ":B" & NewRow & ")"

bkMonth = AllSht.Range("R1")
bkYear = AllSht.Range("S1")
Allbk.SaveAs Filename:=Folder & "\" & AllFileName & bkMonth & bkYear
Allbk.Close SaveAs:=False
End Sub

" wrote:
On May 30, 10:38 pm, Joel wrote:
One other small change

from
If Left(UCase(FName), LenAll) < UCase(Alltotals) Then
to
If Left(UCase(FName), LenAll) < UCase(AllFileName) Then

"Joel" wrote:
Dumb mistake

from:
FName = Folder & "\*.xls"

to:
FName = Dir(Folder & "\*.xls")

" wrote:

On May 30, 8:44 pm, Joel wrote:
try this code. *the codew tests each filename in report and make sure it
doesn't open the All file twice. *It puts the File name in column a in the
total book and thne Sum in column b. *then it creates a Grand total at the
end of the all total Book.

Sub totalbooks()

Folder = "C:\Report"
AllFileName = "Alltotals"
LenAll = Len(AllFileName)

'Open All total book
Set Allbk = Workbooks.Open(Filename:=Folder & "\" _
* *& AllFileName & ".xls")
Set AllSht = Allbk.Sheets(2)
'find last row of in column A
LastRow = AllSht.Range("A" & Rows.Count).End(xlUp).Row
'Newrow is row where report total is put
NewRow = LastRow
FName = Folder & "\*.xls"
Do While FName < ""
* *'Don't open allmonth files
* *If Left(UCase(FName), LenAll) < UCase(Alltotals) Then
* * * Set Reportbk = Workbooks.Open(Filename:=Folder & "\" & FName)
* * * Set Report_T_Sht = Reportbk.Sheets("Total")
* * * Set TotalRange = Report_T_Sht.Range("B6:S60")
* * * Total = WorksheetFunction.Sum(TotalRange)
* * * NewRow = NewRow + 1
* * * AllSht.Range("A" & NewRow) = FName
* * * AllSht.Range("B" & NewRow) = Total
* * * Reportbk.Close
* *End If
* *FName = Dir()
Loop
'add total to All total book as a formula
AllSht.Range("A" & (NewRow + 2)) = "GRAND TOTL"
AllSht.Range("B" & (NewRow + 2)).Formula = _
* *"=SUM(B" & (LastRow + 1) & ":B" & NewRow & ")"

bkMonth = AllSht.Range("R1")
bkYear = AllSht.Range("S1")
Allbk.SaveAs Filename:=Folder & "\" & AllFileName & bkMonth & bkYear
Allbk.Close SaveAs:=False
End Sub

" wrote:
I have over 50 workbooks in a folder called ‘Report’. *They all have
the same layout. *Each workbook has 32 sheets (1-31 and the 32nd sheet
at the end is called ‘Total’) . *I need to automatically open each
sheet in the folder, go to each ‘Total’ sheet and sum them in the 2nd
sheet of a file called “Alltotals’. *‘Alltotals’ has all the headings
and associated graphs. *I would *also then like that file saved as
“AlltotalsMonthYear” . *The Month is in R1 and the year is in S1 on
the ‘Total’ sheet.
I have headings A5:S5 and A5:A61. *The data I would like to sum is
B6:S6 to B60:S60. *I am not sure whether using the consolidate and sum
function is best or if there is another way.
Thank you for any help.
Bob- Hide quoted text -

- Show quoted text -

Thanks Joel,
The Alltotals workbook opens OK, but on the line *Set Reportbk =
Workbooks.Open(Filename:=Folder & "\" & FName)
I *get a run time error 1004, C:\Report\C:Report*.xls could not be
found. *Check the spelling of the filename, and verify that the file
location is correct.
Any ideas?
Thanks
Bob- Hide quoted text -

- Show quoted text -

Thanks again Joel, I made those changes and it worked. *After seeing
the result, I realised that I was unclear in my request. *I essentialy
wanted to consolidate (using sum) all the individual cells in the
total sheets. * *I need to sum the individual cells in each total
sheet (eg. b6 in 1st workbook + b6 in the 2nd + b6 in the 3rd ...+ b6
in the 50th aworkbook and return the total in cell b6 in the alltotals
workbook. same for every other cell in the range. *I hope this makes
sense.
Regards
Bob- Hide quoted text -

- Show quoted text -

Thanks Joel,

*why is the sum range 54 rows (Row 6 to 61) when you have only 31
sheets? * I will try to explain clearer. *I appreciate your effort.

I am trying to understand the code. *It is summing all sheets 1 to
31. *I don't need this because all the totals of sheets 1 to 31 in
each workbook are in the *32nd sheet called 'total'. * Sorry, I should
have been clearer. *It is only these 'total' sheets that I am trying
to sum into the corresponding cells in the allworkbooks file.
Eg, *file1 'total" b6 + file 2 'total" b6 + file 3 'total b6
+ ....file 50 'total' b6 *to give a total in allworkbooks sheet 2 *b6
* * * file1 'total" c6 + file 2 'total" c6 + file 3 'total c6
+ ....file 50 'total' c6 *to give a total in allworkbooks sheet 2
c6....
* * * file1 'total" s6 + file 2 'total" s6 + file 3 'total s6
+ ....file 50 'total' s6 *to give a total in allworkbooks sheet 2
s6....
* * * file1 'total" b61 + file 2 'total" b61 + file 3 'total
cb61+ ....file 50 'total' b61 *to give a total in allworkbooks sheet
2 *C61
* * * file1 'total" s61 + file 2 'total" s61 + file 3 'total
sb61+ ....file 50 'total' s61 *to give a total in allworkbooks sheet
2 *s61....
* * * for all individual cells in that range.
I should mention (it may be relvant) that the totals sheets are
protected sheet (the password is t)

I hope this makes things clearer.
Regards
Bob

I also got On the line, For ColCount = sht.Range("B6").Column To
sht.Range("S6").Column, I get 'Run time Error 424, object required"- Hide quoted text -

- Show quoted text -

Thanks Joel,
That is brilliant - yes that is what I need.
There are 2 minor issues.
1. When each file is opened, the message appears "There is a large
amount of information on the clipboard, Do you want to be able to
paste this information into another program later. Yes/No/Cancel".
It works fine to say No. Is there a way to stop this message from
being displayed?

2. run time error 1004 - Application defined or object defined
error on the line Allbk.Close SaveAs:=False. Is there a way to
prevent this message?
Thanks again
Bob