Macro copy data from multiple workbooks to master

In this code - change the bold sections to match your system -

Option Explicit

Sub cons_files()

Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'The folder containing the files to be recap'd
myPath = "B:\Test"

'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(myPath & "\*.xlsx")

'Create a workbook for the recap report
Set Master = ThisWorkbook

Do
    Workbooks.Open (myPath & "\" & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    Set sourceData = sourceBook.Worksheets("MASTER")
    
        With sourceData
            .Range("A2:O" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
                    Master.Worksheets("MASTER").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With
       
    sourceBook.Close
  
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""

MsgBox "Consolidation complete"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

If there is any data in the final score sheet, do you want it to be cleared before fresh data is input?

Try this code - save it in the Final score file as per the instructions given below the code - change the highlighted sections to match your system -

Option Explicit

Sub cons_data()

Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String

Application.ScreenUpdating = False

'The folder containing the files to be recap'd
myPath = "B:\Test"

'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(myPath & "\*.xlsx")

'Create a workbook for the recap report
Set Master = ThisWorkbook

Do
    Workbooks.Open (myPath & "\" & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    Set sourceData = sourceBook.Worksheets(1)
    
        With sourceData
            .Range("A2:B2").Copy Master.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            
        End With
       
    sourceBook.Close
  
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""

MsgBox "Done"

Application.ScreenUpdating = True

End Sub

Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
Choose Insert | Module
Where the cursor is flashing, choose Edit | Paste

To run the Excel VBA code:
Choose Tools | Macro | Macros
Select a macro in the list, and click the Run button

Note: Your profile says you are using excel 2003 but the files you uploaded are of excel 2007 and above. Please change your profile info to reflect that.

Hi Arlu,
Thanks for your quick responce but
I am geting compilation error msg 9 at bold section can u please check and reply me as i am seeing u r online this time.

Option Explicit

Sub cons_data()

Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String

Application.ScreenUpdating = False

'The folder containing the files to be recap'd
myPath = "C:\Score"

'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(myPath & "\*.xlsx")

'Create a workbook for the recap report
Set Master = ThisWorkbook

Do
    Workbooks.Open (myPath & "" & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    Set sourceData = sourceBook.Worksheets(1)
    
        With sourceData
            .Range("A2:B2").Copy Master.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            
        End With
       
    sourceBook.Close
  
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""

MsgBox "Done"

Application.ScreenUpdating = True

End Sub

Firstly,

I have added code tags to your post. As per forum rule 3, you need to use them whenever you put any code in your post. Please add them in future. If you need more information on how to use them, check my signature below this post.

Have you changed this line CurrentFileName = Dir(myPath & "\*.xlsx") in your code?

You do not need to change this line CurrentFileName = Dir(myPath & "\*.xlsx").

The only line you need to change is myPath = "B:\Test"

Error msg 9 on which line?

Replace this line

Workbooks.Open (myPath & "" & CurrentFileName)

with

Workbooks.Open (myPath & "\" & CurrentFileName)

That error shows that you do not have any .xlsx files in your folder.

If your files are 2003 version files, then change the .xlsx to .xls in that code line.

Change your profile details to reflect excel 2010.

There is no problem with your file. Have you cross checked that the path in the macro matches your system where the files exist?