Sum workbooks cells



i have some problems with this macro... i have a folder of Identical
files which I want to add the values of. However I can't get the
adding of the cells to work...

Do anyone see some obvious problems?

Dim sFileBase As String
Dim sFilename As String

Private Sub cmd_OK_Click()
' Macro recorded 09/01/2006 by Taylor Nelson Sofres plc
' Owner: Christian Simonsen - The Change Team
' Email: (e-mail address removed)

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim ResultSheet As Worksheet
Dim TempSheet As Worksheet
Dim questRange As Range
Dim Cellsum
Dim mAddress

' Application.ScreenUpdating = False
' Application.DisplayAlerts = False
' Application.EnableEvents = False

Set wbCodeBook = ActiveWorkbook
Set ResultSheet = ActiveSheet
mAddress = "C:\Documents and Settings\ChristianS\My Documents\06.02.16
- Excel training qestionaire\Answers"

' Set active Cell

With Application.FileSearch
'Change path to suit
..LookIn = mAddress & "\"
..FileType = msoFileTypeExcelWorkbooks
'.Filename = "Book*.xls"

If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults =
Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

'--------------- CODE HERE ------------------

Set TempSheet = wbResults.ActiveSheet
Set questRange = Range("C9:G19")

For Each Cell In questRange

'Gets the exisiting value in the ResultSheet
Set Cellsum = wbCodeBook.ResultSheet.Cell.Value

' Adds the TempSheet cell value to the cellsum
Cellsum = Cellsum + wbResults.TempSheet.Cell

'Adds the value of the opened sheet to the

wbCodeBook.ResultSheet.Cell = Cellsum

Next Cell

'-------- END -- CODE HERE -- END ------------

' Do not save changes in opened workbooks
wbResults.Close SaveChanges:=False

Next lCount
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

' Close the UserForm
Unload GetFromWorkbook
End Sub

Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Function

Private Sub cmd_Cancel_Click()
Unload GetFromWorkbook
End Sub




Try this:

Set TempSheet = wbResults.ActiveSheet
Set questRange = ThisWorkbook.ActiveSheet.Range("C9:G19")

For Each cell In questRange

cell.Value = cell.Value + TempSheet.Cells(cell.Row, cell.Column)

Next cell

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question