Here is some code that works OK if you keep to the "rules" shown,
otherwise you can change it as you wish.
'==============================================
'- Generic code for transferring data from
'- one or more workbooks to a master sheet
'-
'- workbooks must be the only ones in the folder
'- worksheets must be the first one in the book
'- worksheets must contain tables which are
'- identical to the master, headings in row 1.
'- master sheet is remade each time.
'- run this code from the master book
'-
'----------------------------------------------
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
'-
'----------------
Sub NEW_MASTER()
'----------------
Application.Calculation = xlCalculationManual
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
ToBook = ActiveWorkbook.Name
Set ToSheet = ActiveWorkbook.Worksheets(1)
NumColumns = ToSheet.Range("A1").End(xlToRight).Column
ToRow = ToSheet.Range("A65536").End(xlUp).Row
'- clear master
If ToRow <> 1 Then
ToSheet.Range(Cells(2, 1), Cells(ToRow,
NumColumns)).ClearContents
End If
ToRow = 2
'- main loop
FromBook = Dir("*.xls")
While FromBook <> ""
If FromBook <> ToBook Then
Application.StatusBar = FromBook
Transfer_data
End If
FromBook = Dir
Wend
'-- close
MsgBox ("Done.")
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'-------------------------------------------------
Sub Transfer_data()
Workbooks.Open FileName:=FromBook
Set FromSheet = Workbooks(FromBook).Worksheets(1)
LastRow = FromSheet.Range("A65536").End(xlUp).Row
FromSheet.Range(Cells(2, 1), Cells(LastRow, NumColumns)).Copy _
Destination:=ToSheet.Range("A" & ToRow)
ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
Workbooks(FromBook).Close savechanges:=False
End Sub
'==== EOP ======================================