CONSOLIDATE DATA FROM ALL FILES IN A FOLDER (SOLUTION)

'=========================================================
'- CONSOLIDATE DATA SHEETS
'- (ALL WORKBOOKS IN FOLDER.ALL SHEETS)
'=========================================================
'- Generic code for transferring data from
'- all worksheets from all workbooks contained in a folder
'- to a single sheet.
'- Change "Sub Transfer_data()" etc. as required.
'----------------------------------------------------------
'- Workbooks must be the only ones in the folder.
'----------------------------------------------------------
'- worksheets must be contain tables which are
'- identical to the master, headings in row 1.
'- *master sheet is remade each time*
'- run this code from the master sheet (with headings)
'- by Brian Baulsom (BrianB) January 1st.2004
'----------------------------------------------------------
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
'-
'=========================================================
'- MAIN ROUTINE
'=========================================================
Sub FILES_FROM_FOLDER()
    Application.Calculation = xlCalculationManual
    ChDrive ActiveWorkbook.Path
    ChDir ActiveWorkbook.Path
    ToBook = ActiveWorkbook.Name
    '---------------------------
    '- MASTER SHEET
    '---------------------------
    Set ToSheet = ActiveSheet
    NumColumns = ToSheet.Range("A1").End(xlToRight).Column
    ToRow = ToSheet.Range("A65536").End(xlUp).Row
    '- clear master
    If ToRow <> 1 Then
        ToSheet.Range(ToSheet.Cells(2, 1), _
            ToSheet.Cells(ToRow, NumColumns)).ClearContents
    End If
    ToRow = 2
    '------------------------------------------
    '- main loop to open each file in folder
    '------------------------------------------
    FromBook = Dir("*.xls")
    While FromBook <> ""
        If FromBook <> ToBook Then
            Application.StatusBar = FromBook
            Transfer_data   ' subroutine below
        End If
        FromBook = Dir
    Wend
    '-- close
    MsgBox ("Done.")
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
End Sub
'
'==============================================================
'- CHANGE THIS CODE TO DO WHAT YOU WANT TO THE OPENED WORKBOOK
'- HERE IT COPIES DATA FROM ALL SHEETS TO THE MASTER SHEET
'==============================================================
Private Sub Transfer_data()
    Workbooks.Open FileName:=FromBook
    For Each FromSheet In Workbooks(FromBook).Worksheets
        LastRow = FromSheet.Range("A65536").End(xlUp).Row
        '-----------------------------------------------------
        '- copy/paste to master sheet
        FromSheet.Range(FromSheet.Cells(2, 1), _
            FromSheet.Cells(LastRow, NumColumns)).Copy _
            Destination:=ToSheet.Range("A" & ToRow)
        '-----------------------------------------------------
        '- set next ToRow
        ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
    Next
    Workbooks(FromBook).Close savechanges:=False
End Sub
'==== EOP ====================================================