VB Code to open all files in a directory, copy, paste, close.

[naq_uk]

Hi,

I'm working in a school and have managed to create a excel test template that allows my students to enter their answers and then marks their results saving their answers as a new workbook for each student. This has worked fine and it saves into a specific folder and names each file according to the students name.

The bit I need help with is that I have created a seperate workbook that is a basic table that has the headings: name, surname, form, q1, q2, q3... total. What I need is a macro that will open each file from the specific directory to which the students workbooks have been saved. It should then copy and paste the total values for each question and the students' names etc into this new worksheet. It should then close the students workbook down (no need to save).
Now i'm no Visual Basic expert but i've been kinda talked into trying it out. The problem is the files i'm copying from are around 400 or so. I also need to make sure that it checks for the next empty row in the second workbook then copies into it... so that I am left with a table of results.

Each of the students files are named "Final Results" plus the student name. The second workbook to which I wish to copy is called Results book. The code I have so far is:


Public Sub FileLoop()

Dim fscTemp As FileSearch
Dim MyDir As String
Dim strPath As String
Dim vaFileName As Variant

MyDir = "C:\Documents and Settings\nnaqvi\Desktop\Numeracy Assessment"
strPath = MyDir & "\Student Results Assessment 1" ' files subdir

Set fscTemp = Application.FileSearch
With fscTemp
.FileType = msoFileTypeExcelWorkbooks
.NewSearch
.LookIn = strPath
.SearchSubFolders = False
.Filename = ".xls"
.Execute
End With

With fscTemp
If .FoundFiles.Count > 0 Then
For Each vaFileName In .FoundFiles
Workbooks.Open vaFileName
Call CheckForNewRow
Call EnterRecords
vaFileName.Close
Next
End If
End With
End Sub

The macro CheckForNewRow should check for the next available row and is as follows:

Public Sub CheckForNewRow()

Workbooks(ResultsBook.xls).Activate
Selection.CurrentRegion.Select
If Range(ActiveCell) <> "" Then
Selection.End(xlDown).Select
End If
ActiveCell.Offset(1, -9).Range("A1").Select

End Sub

The macro thatdoes the copy and pasting of values is EnterRecords and is as follows. It switches between the open student result file and the result book to which all results should be copied:

Public Sub EnterRecords()

Workbooks(vaFileName).Activate
Range("M6").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(vaFileName).Activate
Range("M5").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(vaFileName).Activate
Range("M7").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(vaFileName).Activate
Range("M8").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(vaFileName).Activate
Range("C11").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(vaFileName).Activate
Range("C21").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(vaFileName).Activate
Range("C28").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(vaFileName).Activate
Range("C37").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Workbooks(vaFileName).Activate
Range("C48").Select
Selection.Copy
Workbooks("ResultsBook.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"

After copying the values is then calculates the final total.

The problem is that it compiles but when I run the macro it opens the first file in the folder specified and returns and object required error message.

Can anyone help. I need it to open each file one at a time, copy from it, calculate its total then close before proceeding to the next one.

Just to be clear the resultsbook table is set up with the following headings:
SURNAME|FIRST NAME|Q1|Q2|Q3|Q4|Q5|TOTAL

The students individual sheet has the calculated the totals for each question so its just a case of copying over into this ResultsBook table. Basically, I should end up with around 400 rows of data under these headings.

Any help would be greatly appreciated!!!

Thanks in advance for any suggestions