'You can copy the code portions in the same modules as I have done in the example workbook
'but it will also work if you copy the whole txt file in one module

'Ron de Bruin, 20 July 2008
'http://www.rondebruin.nl



'*************************************************************
'****This portion goes in a module named Basic_Code_Module****
'*************************************************************


Private myFiles() As String
Private Fnum As Long

Function Get_File_Names(MyPath As String, Subfolders As Boolean, _
                        ExtStr As String, myReturnedFiles As Variant) As Long

    Dim Fso_Obj As Object, RootFolder As Object
    Dim SubFolderInRoot As Object, file As Object

    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    'Create FileSystemObject object
    Set Fso_Obj = CreateObject("Scripting.FileSystemObject")

    Erase myFiles()
    Fnum = 0

    'Test if the folder exist and set RootFolder
    If Fso_Obj.FolderExists(MyPath) = False Then
        Exit Function
    End If
    Set RootFolder = Fso_Obj.GetFolder(MyPath)

    'Fill the array(myFiles)with the list of Excel files in the folder(s)
    'Loop through the files in the RootFolder
    For Each file In RootFolder.Files
        If LCase(file.Name) Like LCase(ExtStr) Then
            Fnum = Fnum + 1
            ReDim Preserve myFiles(1 To Fnum)
            myFiles(Fnum) = MyPath & file.Name
        End If
    Next file

    'Loop through the files in the Sub Folders if SubFolders = True
    If Subfolders Then
        Call ListFilesInSubfolders(OfFolder:=RootFolder, FileExt:=ExtStr)
    End If

    myReturnedFiles = myFiles
    Get_File_Names = Fnum
End Function


Sub ListFilesInSubfolders(OfFolder As Object, FileExt As String)
'Origenal SubFolder code from Chip Pearson
'http://www.cpearson.com/Excel/RecursionAndFSO.htm
'Changed by Ron de Bruin, 27-March-2008
    Dim SubFolder As Object
    Dim fileInSubfolder As Object

    For Each SubFolder In OfFolder.Subfolders
        ListFilesInSubfolders OfFolder:=SubFolder, FileExt:=FileExt

        For Each fileInSubfolder In SubFolder.Files
            If LCase(fileInSubfolder.Name) Like LCase(FileExt) Then
                Fnum = Fnum + 1
                ReDim Preserve myFiles(1 To Fnum)
                myFiles(Fnum) = SubFolder & "\" & fileInSubfolder.Name
            End If
        Next fileInSubfolder

    Next SubFolder
End Sub


Function RDB_Last(choice As Integer, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
    Dim lrw As Long
    Dim lcol As Integer

    Select Case choice

    Case 1:
        On Error Resume Next
        RDB_Last = rng.Find(What:="*", _
                            after:=rng.Cells(1), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        RDB_Last = rng.Find(What:="*", _
                            after:=rng.Cells(1), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       after:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        after:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        RDB_Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            RDB_Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
End Function




'**********************************************************
'****This portion goes in a module named Get_Data_Macro****
'**********************************************************

'The example macro below you can use to merge a fixed range or
'all cells from one or all worksheets from each workbook in a folder

'First we call the Function "Get_File_Names" to fill a array with all file names
'There are three arguments in this Function that we can change

'1) MyPath = the folder where the files are
'2) Subfolders = True if you want to include subfolders
'3) ExtStr = file extension of the files you want to merge
'   ExtStr examples are: "*.xls" , "*.csv" , "*.xlsx"
'   "*.xlsm" ,"*.xlsb" , for all Excel file formats use "*.xl*"
'   Do not change myReturnedFiles:=myFiles


'Then if there are files in the folder we call the macro "Get_Data"
'There are six arguments in this macro that we can change


'1) FileNameInA = True to add the path/file name in the A column
'2) PasteAsValues = True to paste as values (recommend)
'3) SourceShName = sheet name, if "" it will use the SourceShIndex and if "all" it copy from all worksheets
'4) SourceShIndex = to avoid problems with different sheet names use the index (1 is the first worksheet)
'5) SourceRng = Range you want to copy. Tip: "A:F" will copy all cells with data in this six columns
'6) StartCell = Enter the first cell and the macro will copy from that cell till the last cell on the worksheet
'   If StartCell = "" then it use the SourceRng
'   Do not change myReturnedFiles:=myFiles


'The example below will merge A1:G1 from the first worksheet of each file
'It will use a fixed range on the first worksheet because SourceShName and StartCell are ""

Sub RDB_Merge_Data()
    Dim myFiles As Variant
    Dim myCountOfFiles As Long

    myCountOfFiles = Get_File_Names( _
                     MyPath:="C:\Users\Ron\test", _
                     Subfolders:=False, _
                     ExtStr:="*.xl*", _
                     myReturnedFiles:=myFiles)

    If myCountOfFiles = 0 Then
        MsgBox "No files that match the ExtStr in this folder"
        Exit Sub
    End If

    Get_Data _
            FileNameInA:=True, _
            PasteAsValues:=True, _
            SourceShName:="", _
            SourceShIndex:=1, _
            SourceRng:="A1:G1", _
            StartCell:="", _
            myReturnedFiles:=myFiles

End Sub



'With the macro below you can browse to the folder instead of enter in in the code

Sub RDB_Merge_Data_Browse()
    Dim myFiles As Variant
    Dim myCountOfFiles As Long
    Dim oApp As Object
    Dim oFolder As Variant

    Set oApp = CreateObject("Shell.Application")

    'Browse to the folder
    Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
    If Not oFolder Is Nothing Then

        myCountOfFiles = Get_File_Names( _
                         MyPath:=oFolder.Self.Path, _
                         Subfolders:=False, _
                         ExtStr:="*.xl*", _
                         myReturnedFiles:=myFiles)

        If myCountOfFiles = 0 Then
            MsgBox "No files that match the ExtStr in this folder"
            Exit Sub
        End If

        Get_Data _
                FileNameInA:=True, _
                PasteAsValues:=True, _
                SourceShName:="", _
                SourceShIndex:=1, _
                SourceRng:="A1:G1", _
                StartCell:="", _
                myReturnedFiles:=myFiles

    End If

End Sub




' Note: You not have to change the macro below, you only
' edit and run the RDB_Merge_Data above.


Sub Get_Data(FileNameInA As Boolean, PasteAsValues As Boolean, SourceShName As String, _
             SourceShIndex As Integer, SourceRng As String, StartCell As String, myReturnedFiles As Variant)
    Dim SourceRcount As Long
    Dim SourceRange As Range, destrange As Range
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim rnum As Long, CalcMode As Long
    Dim SourceSh As Variant
    Dim sh As Worksheet
    Dim I As Long

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Add a new workbook with one sheet named "Combine Sheet"
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    BaseWks.Name = "Combine Sheet"

    'Set start row for the Data
    rnum = 1

    'Check if we use a named sheet or the index
    If SourceShName = "" Then
        SourceSh = SourceShIndex
    Else
        SourceSh = SourceShName
    End If

    'Loop through all files in the array(myFiles)
    For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(myReturnedFiles(I))
        On Error GoTo 0

        If Not mybook Is Nothing Then

            If LCase(SourceShName) <> "all" Then

                'Set SourceRange and check if it is a valid range
                On Error Resume Next

                If StartCell <> "" Then
                    With mybook.Sheets(SourceSh)
                        Set SourceRange = .Range(StartCell & ":" & RDB_Last(3, .Cells))
                        'Test if the row of the last cell >= then the row of the StartCell
                        If RDB_Last(1, .Cells) < .Range(StartCell).Row Then
                            Set SourceRange = Nothing
                        End If
                    End With
                Else
                    With mybook.Sheets(SourceSh)
                        Set SourceRange = Application.Intersect(.UsedRange, .Range(SourceRng))
                    End With
                End If

                If Err.Number > 0 Then
                    Err.Clear
                    Set SourceRange = Nothing
                Else
                    'if SourceRange use all columns then skip this file
                    If SourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set SourceRange = Nothing
                    End If
                End If

                On Error GoTo 0

                If Not SourceRange Is Nothing Then

                    'Check if there enough rows to paste the data
                    SourceRcount = SourceRange.Rows.Count
                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "Sorry there are not enough rows in the sheet to paste"
                        mybook.Close savechanges:=False
                        BaseWks.Parent.Close savechanges:=False
                        GoTo ExitTheSub
                    End If

                    'Set the destination cell
                    If FileNameInA = True Then
                        Set destrange = BaseWks.Range("B" & rnum)
                        With SourceRange
                            BaseWks.Cells(rnum, "A"). _
                                    Resize(.Rows.Count).Value = myReturnedFiles(I)
                        End With
                    Else
                        Set destrange = BaseWks.Range("A" & rnum)
                    End If

                    'Copy/paste the data
                    If PasteAsValues = True Then
                        With SourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = SourceRange.Value
                    Else
                        SourceRange.Copy destrange
                    End If

                    rnum = rnum + SourceRcount
                End If

                'Close the workbook without saving
                mybook.Close savechanges:=False

            Else

                'Loop through all sheets in mybook
                For Each sh In mybook.Worksheets

                    'Set SourceRange and check if it is a valid range
                    On Error Resume Next

                    If StartCell <> "" Then
                        With sh
                            Set SourceRange = .Range(StartCell & ":" & RDB_Last(3, .Cells))
                            If RDB_Last(1, .Cells) < .Range(StartCell).Row Then
                                Set SourceRange = Nothing
                            End If
                        End With
                    Else
                        With sh
                            Set SourceRange = Application.Intersect(.UsedRange, .Range(SourceRng))
                        End With
                    End If

                    If Err.Number > 0 Then
                        Err.Clear
                        Set SourceRange = Nothing
                    Else
                        'if SourceRange use almost all columns then skip this file
                        If SourceRange.Columns.Count > BaseWks.Columns.Count - 2 Then
                            Set SourceRange = Nothing
                        End If
                    End If
                    On Error GoTo 0

                    If Not SourceRange Is Nothing Then

                        'Check if there enough rows to paste the data
                        SourceRcount = SourceRange.Rows.Count
                        If rnum + SourceRcount >= BaseWks.Rows.Count Then
                            MsgBox "Sorry there are not enough rows in the sheet to paste"
                            mybook.Close savechanges:=False
                            BaseWks.Parent.Close savechanges:=False
                            GoTo ExitTheSub
                        End If

                        'Set the destination cell
                        If FileNameInA = True Then
                            Set destrange = BaseWks.Range("C" & rnum)
                            With SourceRange
                                BaseWks.Cells(rnum, "A"). _
                                        Resize(.Rows.Count).Value = myReturnedFiles(I)
                                BaseWks.Cells(rnum, "B"). _
                                        Resize(.Rows.Count).Value = sh.Name
                            End With
                        Else
                            Set destrange = BaseWks.Range("A" & rnum)
                        End If

                        'Copy/paste the data
                        If PasteAsValues = True Then
                            With SourceRange
                                Set destrange = destrange. _
                                                Resize(.Rows.Count, .Columns.Count)
                            End With
                            destrange.Value = SourceRange.Value
                        Else
                            SourceRange.Copy destrange
                        End If

                        rnum = rnum + SourceRcount
                    End If

                Next sh

                'Close the workbook without saving
                mybook.Close savechanges:=False
            End If
        End If

        'Open the next workbook
    Next I

    'Set the column width in the new workbook
    BaseWks.Columns.AutoFit

ExitTheSub:
    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub




'************************************************************
'****This portion goes in a module named Get_Filter_Macro****
'************************************************************


'The example below will filter the A column of the first worksheet from
'each file for "ron" and copy the results to a new workbook

'First we call the Function "Get_File_Names" to fill a array with all file names
'There are three arguments in this Function that we can change

'1) MyPath = the folder where the files are
'2) Subfolders = True if you want to include subfolders
'3) ExtStr = file extension of the files you want to merge
'   ExtStr examples are: "*.xls" , "*.csv" , "*.xlsx"
'   "*.xlsm" ,"*.xlsb" , for all Excel file formats use "*.xl*"
'   Do not change myReturnedFiles:=myFiles

'Then if there are files in the folder we call the macro "Get_Filter"
'There are six arguments in this macro that we can change

'1) FileNameInA = True to paste the file name in the A column (recommend)
'2) SourceShName = Sheet name, if "" it will use the SourceShIndex
'3) SourceShIndex = to avoid problems with different sheet names use the index (1 is the first worksheet)

'4) FilterRng = range that you want to filter: A1 is the header of the first column and D is the last column
' in this example. Because I use & Rows.Count it will use all rows on the sheet.
' You can also use a fixed range if you want like FilterRng:="A1:D3500"

'5) FilterField = the range start in column A so field 1 = column A and field 3 = column C

'6) FilterValue = Use "<>ron" if you want the opposite
'   Or use wildcards like "*ron" for cells that start with ron or use
'   "*ron* if you look for cells where ron is a part of the cell value

'   Do not change myReturnedFiles:=myFiles


Sub RDB_Filter_Data()
    Dim myFiles As Variant
    Dim myCountOfFiles As Long

    myCountOfFiles = Get_File_Names( _
                     MyPath:="C:\Users\Ron\test", _
                     Subfolders:=False, _
                     ExtStr:="*.xl*", _
                     myReturnedFiles:=myFiles)


    If myCountOfFiles = 0 Then
        MsgBox "No files that match the ExtStr in this folder"
        Exit Sub
    End If

    Get_Filter _
            FileNameInA:=True, _
            SourceShName:="", _
            SourceShIndex:=1, _
            FilterRng:="A1:D" & Rows.Count, _
            FilterField:=1, _
            FilterValue:="ron", _
            myReturnedFiles:=myFiles

End Sub


' Note: You not have to change the macro below, you only
' edit and run the RDB_Filter_Data above.


Sub Get_Filter(FileNameInA As Boolean, SourceShName As String, _
               SourceShIndex As Integer, FilterRng As String, FilterField As Integer, _
               FilterValue As String, myReturnedFiles As Variant)
    Dim SourceRange As Range, destrange As Range
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim rnum As Long, CalcMode As Long
    Dim SourceSh As Variant
    Dim rng As Range
    Dim RwCount As Long
    Dim I As Long

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Add a new workbook with one sheet named "Combine Sheet"
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    BaseWks.Name = "Combine Sheet"

    'Set start row for the Data
    rnum = 1

    'Check if we use a named sheet or the index
    If SourceShName = "" Then
        SourceSh = SourceShIndex
    Else
        SourceSh = SourceShName
    End If

    'Loop through all files in the array(myFiles)
    For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(myReturnedFiles(I))
        On Error GoTo 0

        If Not mybook Is Nothing Then

            'Set SourceRange and check if it is a valid range
            On Error Resume Next

            With mybook.Sheets(SourceSh)
                Set SourceRange = Application.Intersect(.UsedRange, .Range(FilterRng))
            End With

            If Err.Number > 0 Then
                Err.Clear
                Set SourceRange = Nothing
            Else
                'if SourceRange use all columns then skip this file
                If SourceRange.Columns.Count >= BaseWks.Columns.Count Then
                    Set SourceRange = Nothing
                End If
            End If
            On Error GoTo 0

            If Not SourceRange Is Nothing Then

                'Find the last row in BaseWks
                rnum = RDB_Last(1, BaseWks.Cells) + 1

                With SourceRange.Parent
                    Set rng = Nothing

                    'Firstly, remove the AutoFilter
                    .AutoFilterMode = False

                    'Filter the range on the FilterField column
                    SourceRange.AutoFilter Field:=FilterField, _
                                           Criteria1:=FilterValue

                    With .AutoFilter.Range
                        'Check if there are results after you use AutoFilter
                        RwCount = .Columns(1).Cells. _
                                  SpecialCells(xlCellTypeVisible).Cells.Count - 1

                        If RwCount = 0 Then
                            'There is no data, only the header
                        Else
                            ' Set a range without the Header row
                            Set rng = .Resize(.Rows.Count - 1, .Columns.Count). _
                                      Offset(1, 0).SpecialCells(xlCellTypeVisible)

                            If FileNameInA = True Then
                                'Copy the range and the file name
                                If rnum + RwCount < BaseWks.Rows.Count Then
                                    BaseWks.Cells(rnum, "A").Resize(RwCount).Value _
                                          = mybook.Name
                                    rng.Copy BaseWks.Cells(rnum, "B")
                                End If
                            Else
                                'Copy the range
                                If rnum + RwCount < BaseWks.Rows.Count Then
                                    rng.Copy BaseWks.Cells(rnum, "A")
                                End If
                            End If
                        End If
                    End With

                    'Remove the AutoFilter
                    .AutoFilterMode = False

                End With
            End If

            'Close the workbook without saving
            mybook.Close savechanges:=False
        End If

        'Open the next workbook
    Next I

    'Set the column width in the new workbook
    BaseWks.Columns.AutoFit

    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub




'***********************************************************
'****This portion goes in a module named Get_Sheet_Macro****
'***********************************************************


'The example below will copy the first worksheet from each file in a new workbook
'It copy as values because the PasteAsValues argument = True

'First we call the Function "Get_File_Names" to fill a array with all file names
'There are three arguments in this Function that we can change

'1) MyPath = the folder where the files are
'2) Subfolders = True if you want to include subfolders
'3) ExtStr = file extension of the files you want to merge
'   ExtStr examples are: "*.xls" , "*.csv" , "*.xlsx"
'   "*.xlsm" ,"*.xlsb" , for all Excel file formats use "*.xl*"
'   Do not change myReturnedFiles:=myFiles


'Then if there are files in the folder we call the macro "Get_Sheet"
'There are three arguments in this macro that we can change


'1) PasteAsValues = True to paste as values (recommend)
'2) SourceShName = sheet name, if "" it will use the SourceShIndex
'3) SourceShIndex = to avoid problems with different sheet names use the index (1 is the first worksheet)
'   Do not change myReturnedFiles:=myFiles


Sub RDB_Copy_Sheet()
    Dim myFiles As Variant
    Dim myCountOfFiles As Long

    myCountOfFiles = Get_File_Names( _
                     MyPath:="C:\Users\Ron\test", _
                     Subfolders:=False, _
                     ExtStr:="*.xl*", _
                     myReturnedFiles:=myFiles)

    If myCountOfFiles = 0 Then
        MsgBox "No files that match the ExtStr in this folder"
        Exit Sub
    End If

    Get_Sheet _
            PasteAsValues:=True, _
            SourceShName:="", _
            SourceShIndex:=1, _
            myReturnedFiles:=myFiles

End Sub



' Note: You not have to change the macro below, you only
' edit and run the RDB_Copy_Sheet above.


Sub Get_Sheet(PasteAsValues As Boolean, SourceShName As String, _
              SourceShIndex As Integer, myReturnedFiles As Variant)
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim CalcMode As Long
    Dim SourceSh As Variant
    Dim sh As Worksheet
    Dim I As Long

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    On Error GoTo ExitTheSub

    'Add a new workbook with one sheet
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)


    'Check if we use a named sheet or the index
    If SourceShName = "" Then
        SourceSh = SourceShIndex
    Else
        SourceSh = SourceShName
    End If

    'Loop through all files in the array(myFiles)
    For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(myReturnedFiles(I))
        On Error GoTo 0

        If Not mybook Is Nothing Then

            'Set sh and check if it is a valid
            On Error Resume Next
            Set sh = mybook.Sheets(SourceSh)

            If Err.Number > 0 Then
                Err.Clear
                Set sh = Nothing
            End If
            On Error GoTo 0

            If Not sh Is Nothing Then
                sh.Copy after:=BaseWks.Parent.Sheets(BaseWks.Parent.Sheets.Count)

                On Error Resume Next
                ActiveSheet.Name = mybook.Name
                On Error GoTo 0

                If PasteAsValues = True Then
                    With ActiveSheet.UsedRange
                        .Value = .Value
                    End With
                End If

            End If
            'Close the workbook without saving
            mybook.Close savechanges:=False
        End If

        'Open the next workbook
    Next I

    ' delete the first sheet in the workbook
    Application.DisplayAlerts = False
    On Error Resume Next
    BaseWks.Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

ExitTheSub:
    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub