Sub AABB()
Dim sPath As String
Dim v As Variant
Dim bk As Workbook
Dim bkSum As Workbook
Dim i As Long
Dim sh As Worksheet
Dim cell As Range
Dim rng As Range
Dim sh as worksheet
sPath = "C:\Documents and Settings\MyDocuments\"
v = Array("WB1.xls", "WB2.xls", "WB3.xls")
Set bk = Workbooks.Open(sPath & v(LBound(v)))
bk.Worksheets.Copy
Set bkSum = ActiveWorkbook
for each sh in bkSum.worksheets
if lcase(sh.name) <> "sheet3" and lcase(sh.name) <> "sheet7" then
application.displayalerts = False
sh.Delete
application.Displayalerts = True
else
sh.UsedRange.Formula = sh.UsedRange.Value
end if
Next
bk.Close SaveChanges:=False
For i = LBound(v) + 1 To UBound(v)
Set bk = Workbooks.Open(sPath & v(LBound(v)))
For Each sh In bkSum.Worksheets
For Each cell In sh.UsedRange
If IsNumeric(cell.Value) Then
Set rng = bk.Worksheets(sh.Name).Range(cell.Address)
If IsNumeric(rng.Value) Then
cell.Value = cell.Value + rng.Value
End If
End If
Next
Next
Next
End Sub
If the formulas refer to other sheets, then the loop might have to be
changed.
--
Regards,
Tom Ogilvy
Ronbo said:
Tom:
I tried it on the real thing and most cells came up with #REF!. Thses are
cells that are formulas. They make up about 98% of all cells. ?
:
Tom:
Thanks, it works perfect (in my test situation). Implementing it into my
real situation I realized that the files are in differant directories. How
do I compensate for that? Also, is there a way to put this routine in to a
Summary Workbook, rather than having it creating a new book? I would like to
use the same workbook each month with the layout and macros.
Sorry for all of the questions, but this level of programming is way beyond
my skills.
I am soon going to quit for the weekend. How do I get back to this topic on
Monday?
Start a new question or come back here?
Again, Thanks a lot (as always) for your help.
:
Sub AABB()
Dim sPath As String
Dim v As Variant
Dim bk As Workbook
Dim bkSum As Workbook
Dim i As Long
Dim sh As Worksheet
Dim cell As Range
Dim rng As Range
Dim sh as worksheet
sPath = "C:\Documents and Settings\MyDocuments\"
v = Array("WB1.xls", "WB2.xls", "WB3.xls")
Set bk = Workbooks.Open(sPath & v(LBound(v)))
bk.Worksheets.Copy
Set bkSum = ActiveWorkbook
for each sh in bkSum.worksheets
if lcase(sh.name) <> "sheet3" and lcase(sh.name) <> "sheet7" then
application.displayalerts = False
sh.Delete
application.Displayalerts = True
end if
Next
bk.Close SaveChanges:=False
For i = LBound(v) + 1 To UBound(v)
Set bk = Workbooks.Open(sPath & v(LBound(v)))
For Each sh In bkSum.Worksheets
For Each cell In sh.UsedRange
If IsNumeric(cell.Value) Then
Set rng = bk.Worksheets(sh.Name).Range(cell.Address)
If IsNumeric(rng.Value) Then
cell.Value = cell.Value + rng.Value
End If
End If
Next
Next
Next
End Sub
Adjust names to match your actual situation.
--
Regards,
Tom Ogilvy
Tom:
Thanks alot. Thats cool. It works perfect.
What would I do if I only wanted to add only Worksheet3 and worksheet7?
:
Sub AABB()
Dim sPath As String
Dim v As Variant
Dim bk As Workbook
Dim bkSum As Workbook
Dim i As Long
Dim sh As Worksheet
Dim cell As Range
Dim rng As Range
sPath = "C:\Documents and Settings\MyDocuments\"
v = Array("WB1.xls", "WB2.xls", "WB3.xls")
Set bk = Workbooks.Open(sPath & v(LBound(v)))
bk.Worksheets.Copy
Set bkSum = ActiveWorkbook
bk.Close SaveChanges:=False
For i = LBound(v) + 1 To UBound(v)
Set bk = Workbooks.Open(sPath & v(LBound(v)))
For Each sh In bkSum.Worksheets
For Each cell In sh.UsedRange
If IsNumeric(cell.Value) Then
Set rng = bk.Worksheets(sh.Name).Range(cell.Address)
If IsNumeric(rng.Value) Then
cell.Value = cell.Value + rng.Value
End If
End If
Next
Next
Next
End Sub
--
Regards,
Tom Ogilvy
I have 3 workbooks (and adding), with 20 worksheets each, with all
workbooks
and worksheets laid out exactly the same, I want a summary workbook
that
would add each worksheet from the 3 workbooks together so that the
summary
workbook would have 20 worksheets exactly the same as the 3 originals.
i.e.C:\Documents and Settings\My
Documents\[WB1.xls]Sheet1'!A1+C:\Documents
and Settings\My Documents\[WB2.xls]Sheet1'!A1+'C:\Documents and
SettingsMy
Documents[WB3.xls]Sheet1'!A1.
I know that I can copy this across and down, but I do not want to do
it
that
way because it is very time consuming to add a new workbook and it
won't
be
long before I run out of character space in the formula.
I checked out Ron de Bruins site, but I did not find anything that
adds
the
sheet together.
I am looking for a way to add the workbooks or worksheets together and
easily add a new workbook. Any help or suggestions would be
appreciated.
