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:
'
'

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
Range("A4").Select



With Application.FileSearch
..NewSearch
'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
varaible
Cellsum = Cellsum + wbResults.TempSheet.Cell

'Adds the value of the opened sheet to the
ResultSheet

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


--
Ctech


------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=513701