Duplicate a Formula in 1000 Spreadsheets

[stratis]

I do have 1000 spreadsheets which keep the data in the same structure.
I do have a number of Cells lets say A1,B1,C1,D1, E1 that include some
functions by calculating the same numbers in each spreadhseet
like Average, Sum(A:A), SUmif etc. Is there a way that that I can insert
this formulas into every workbook in the folder without haveing to open it
copy, paste and svae it every time.

 

[Tom Ogilvy]

The workbooks would have to be opened, updated and saved, but using a macro
would make it pretty effortless on your part

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"
sName = dir(sPath & "*.xls")
do while sName <> ""
if lcase(sName) <> lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
sName = dir()
end if
Loop
End Sub

would be an example.

 

[stratis]

Thank Tom
Its very usefull. Howeveer The macro Keeps running without stopping Endless.
Note that since I do not know in each of the worksheets how many rows there
are the Sum furmuls is SUM (E:E) Not SUM(Ex:Ey)
Any ideas?

Ο χÏήστης "Tom Ogilvy" έγγÏαψε:

 

[Tom Ogilvy]

A typo on a last minute change

Sub UpdateBooks()
Dim sPath as String, sName as String
Dim bk as Workbook
sPath = "C:\Myfolder\"

sName = dir(sPath & "*.xls")
do while sName <> ""
if lcase(sName) <> lcase(thisworkbook.Name) then
set bk = workbooks.Open(sPath & sName)
bk.Worksheets(1).Range("A1").Formula = "=Sum(A2:A10)"
bk.Close SaveChanges:=True
end if
sName = dir()
Loop
End Sub

 

[Joel]

Complete code

Sub UpdateBooks()
Dim sPath As String, sName As String
Dim bk As Workbook
Dim wb As Workbook
sPath = "C:\temp\test\"
sName = Dir(sPath & "*.xls")

Set wb = ThisWorkbook
RowCount = 1
Do While sName <> ""
If LCase(sName) <> LCase(ThisWorkbook.Name) Then
Set bk = Workbooks.Open(sPath & sName)

Call addsummary(bk)
bk.Worksheets(1).Range("A11").Copy

wb.Worksheets(1).Activate
Cells(RowCount, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
RowCount = RowCount + 1
bk.Close SaveChanges:=True
sName = Dir()
End If
Loop
End Sub
Sub addsummary(bk As Workbook)

With bk.Worksheets(1)
'testt if summary orw already exists
If .Cells(1, "E") = "Summary" Then

Else


.Cells(1, "A").EntireRow.Insert
.Cells(1, "E") = "Summary"
.Cells(1, "A") = .Cells(3, "A")

Lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
.Cells(1, "B").Formula = "=sum(B3:B" & Lastrow & ")"
.Cells(1, "C").Formula = "=sum(C3:C" & Lastrow & ")"


.Cells(1, "D").Formula = "=SumIf(D3" & Lastrow & _
",""Final"", C3:C" & Lastrow & ")"
End If
End With
End Sub

 

[stratis]

Great almost worked.
One slight problem
The problem is that when I use a formula like sumif(A:A,"Regional",B:B) the
macro is crashing
any ideas

Ο χÏήστης "Joel" έγγÏαψε:

 

[Tim Williams]

Show the exact line(s) of code causing the problem. Remember you need to
double-up quotes if you use them inside a string.

Eg:
..Cells(1, "B").Formula = "=sumif(A:A,""Regional"",B:B)"

Tim

 

[Joel]

Look at my syntax for similar statement

..Cells(1, "D").Formula = "=SumIf(D3" & Lastrow & _
",""Final"", C3:C" & Lastrow & ")"

Your should be something like this
..Cells(1, "D").Formula = "=sumif(A:A,""Regional"",B:B)"

the double quotes are needed so that VBA replaces it with a single quote