Sum up identical workbooks

[Ctech]

Hi

I have a 50 replies from a questionaire.. they have all filled in with the number 1 for their choice. (all the workbooks is in the same folder)

I'm trying to use an empty template of this questionaire, and have a macro sum up all the responses of the other workbooks in this template.

Answere range is "C9:G19".

I've tried for two days now and Im about to give up... can some of you give me some advice please.

Thanks

[Toppers]

Hi,
See my reply (17th Feb) to your last posting ... does this help?

"Ctech" wrote:

>
> Hi
>
> I have a 50 replies from a questionaire.. they have all filled in with
> the number 1 for their choice. (all the workbooks is in the same
> folder)
>
> I'm trying to use an empty template of this questionaire, and have a
> macro sum up all the responses of the other workbooks in this
> template.
>
> Answere range is "C9:G19".
>
> I've tried for two days now and Im about to give up... can some of you
> give me some advice please.
>
> Thanks
>
>
> --
> Ctech
>
>
> ------------------------------------------------------------------------
> Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
> View this thread: http://www.excelforum.com/showthread...hreadid=514342
>
>

[Ctech]

See my reply (17th Feb) to your last posting ... does this help?

Yeah it helped some, however not quite... anyway with some tweek I managed to come up with a working macro... if of interest, I have pasted in below....


The macro:


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: christian.simonsen@tns-global.com
'
'

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wbSheet As Worksheet
Dim mRows As Long
Dim mSheet As String
Dim mCostCenter
Dim mRange


Dim tempValue
Dim newTempSheet As Worksheet

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


Set wbCodeBook = ActiveWorkbook
Set wbSheet = ActiveSheet
' Set active Cell
Range("A4").Select

mAddress = GetFromWorkbook.Txt_Address.Text
mRange = GetFromWorkbook.RefEdit_Range.Text
mSheet = GetFromWorkbook.Txt_Sheet.Text
mCostCenter = GetFromWorkbook.RefEdit_mCostCenter.Text


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 ------------------
wbResults.Activate
Cells.Select
Selection.Copy


wbCodeBook.Activate
Sheets.Add
Set newTempSheet = ActiveSheet
newTempSheet.Paste
Application.CutCopyMode = False

For Each cell In Range(mRange)

wbSheet.Cells(cell.Row, cell.Column).Value = wbSheet.Cells(cell.Row, cell.Column).Value + newTempSheet.Cells(cell.Row, cell.Column)


Next cell

Application.DisplayAlerts = False
newTempSheet.Delete
Application.DisplayAlerts = True


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




Private Sub cmd_Cancel_Click()
Unload GetFromWorkbook
End Sub

Private Sub Frame1_Click()

End Sub