Combine multiple workbooks into one single workbook

I am trying to combine ~300 workbooks into one single workbook. All 300 workbooks have the exact same header. I tried using the code from thread https://www.excelforum.com/showthread.php?p=696435 but nothing is being copied over. The only difference between my example and the other is I only need to take data from the first sheet in each data workbook. All the workbooks are located in following directory

 F:\Excel Tips\Combine Workbooks\WorkbookData

The “master file” is located in another directory. The “master file” also has the same header as the data workbooks. Basically, I want to retrieve all data (excluding the header) from the first data workbook and copy to the master file. Then I want to go to the second workbook and retrieve all data from the second data workbook and copy to master file, and so on. The code I am using to combine is as follows:

 Sub Get_Value_From_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng   As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow   As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False

        On Error Resume Next

        Set wbThis = ThisWorkbook
        'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        If uRng.Cells.Count <= 1 Then
            'no data in master sheet
            bHeaders = False
            GoTo search
        End If
        uRng.Offset(1, 0).Resize(uRng.Rows.Count - 1, _
                                 uRng.Columns.Count).Clear
search:
        With .FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "F:\Excel Tips\Combine Workbooks\WorkbookData"
            .FileType = msoFileTypeExcelWorkbooks

            If .Execute > 0 Then    'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count    ' Loop through all.
                    'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    For i = 1 To Sheets.Count - 1
                        Set rToCopy = wbSource.Worksheets(i).UsedRange
                        Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                        If bHeaders Then
                            'headers exist so don't copy
                            rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                        rToCopy.Columns.Count).Copy rNextCl
                            'no headers so copy
                            'place headers in Row 2
                        Else: rToCopy.Copy Cells(1, 1)
                            bHeaders = True
                        End If
                    Next i
                    wbSource.Close False     'close source workbook
                Next lCount
            Else: MsgBox "No workbooks found"
            End If
        End With

        CalcMode = .Calculation
        .Calculation = xlCalculationManual
    End With
'not checked following code
            With ActiveSheet
                .Select
    
                ViewMode = ActiveWindow.View
                ActiveWindow.View = xlNormalView
    
                .DisplayPageBreaks = False
    
                Firstrow = .UsedRange.Cells(1).Row
                Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
                For Lrow = Lastrow To Firstrow Step -1
                    With .Cells(Lrow, "A")
                        If Not IsError(.Value) Then
                            If .Value = "" Then .EntireRow.Delete
                        End If
                    End With
                Next Lrow
            End With
            On Error GoTo 0
            ScreenUpdating = True
            DisplayAlerts = True
            EnableEvents = True
        'End With
End Sub

Thank you in advance for any assistance.

FileSearch doesn't work in Excel 2007, so to have a method that will work in all your Excel versions, try this macro of mine I use for this very task.

The only additional thing you would need to do is create a folder called "Imported" inside the folder with the files, the macro will import the data and move the files to the imported folder so there's no chance they'll be imported again if you run it a second time.

OR...delete the two lines of code that say "Optional" and that part will go away.

Option Explicit

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       9/15/2009     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    Sheets("Master").Activate   'sheet report is built into...edit to match
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        Range("A2:A" & Rows.Count).EntireRow.ClearContents
        NR = 2
    Else
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir             'memorizes the user's current working path
    fPath = "F:\Excel Tips\Combine Workbooks\WorkbookData\"
    fPathDone = "F:\Excel Tips\Combine Workbooks\WorkbookData\Imported]"   'optional
    ChDir fPath
    fName = Dir("*.xl*")      'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        'Open file
            Set wbkOld = Workbooks.Open(fName)
        'Find last row and copy data
            Sheets(1).Activate
            LR = Range("A" & Rows.Count).End(xlUp).Row   'find the bottom row of data...change to a different column if "A" isn't reliable for spotting this value
            Range("A1:A" & LR).EntireRow.Copy _
                wbkNew.Sheets("Master").Range("A" & NR)
        'close file
            wbkOld.Close False
        'Next row
            NR = Range("A" & Rows.Count).End(xlUp).Row + 1
        'move file to "imported" folder
            Name fPath & fName As fPathDone & fName         'optional
        'ready next filename
            fName = Dir
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'restores user's original working path
    ChDir OldDir
End Sub

I have a macro for that, too.

Sub Consolidate()
'Open all Excel files in a specific folder and import data as separate sheets
'JBeaucaire (7/6/2009)     (2007 compatible)
Dim strFileName As String, strPath As String
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Set wbkNew = ThisWorkbook
strPath = "G:\Excel Tips\Combine Workbooks\WorkbookData\"
If Left(strPath, 1) <> "\" Then strPath = strPath & "\"

strFileName = Dir(strPath & "*.xl*")
wbkNew.Activate

'Clear existing files (optional, remove this section if appending is desired)
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    For Each ws In Worksheets
        If ws.Name <> "Temp" Then ws.Delete
    Next ws
    
'Import first active sheet from found file
    Do While Len(strFileName) > 0
        Set wbkOld = Workbooks.Open(strPath & strFileName)
        ActiveSheet.Name = Left(strFileName, Len(strFileName) - 4)
        ActiveSheet.Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
        strFileName = Dir
        wbkOld.Close False
    Loop
    
wbkNew.Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Could be several things. I imagine having the MasterCombined in the same directory as the files to import is probably a bad idea. So move it so that it resides elsewhere, maybe inside the IMPORTED directory?

Here's one last tweak on the macro, they all work for me, so I can't imagine what's going wrong for you. Your uploaded sheet didn't include the macro, so I couldn't see what/where you actually placed the macro...goes in a standard module (Insert > Module).

Sub Consolidate()
'Author:     JBeaucaire'
'Date:       9/15/2009     (2007 compatible)'
'Summary:    Open all Excel files in a specific folder and merge data'
'            into one master sheet (stacked)'
'            Moves imported files into another folder'
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbkNew = ThisWorkbook
    Set ws = wbkNew.Sheets("Start") 'sheet report is built into...edit to match
    
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        ws.Range("A2:A" & Rows.Count).EntireRow.ClearContents
        NR = 2
    Else
        NR = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
    End If

'Path and filename
    OldDir = CurDir             'memorizes the user's current working path
    fPath = "G:\Excel Tips\Combine Workbooks\WorkbookData\"
    fPathDone = "G:\Excel Tips\Combine Workbooks\WorkbookData\Imported\"   'optional
    ChDir fPath
    fName = Dir("Book*.xl*")      'filtering key, change to suit

'Import a sheet from found file
    Do While Len(fName) > 0
        'Open file
            Set wbkOld = Workbooks.Open(fName)
        'Find last row and copy data
            Sheets(1).Activate
            LR = Range("A" & Rows.Count).End(xlUp).Row   'find the bottom row of data...change to a different column if "A" isn't reliable for spotting this value
            Range("A2:A" & LR).EntireRow.Copy _
                ws.Range("A" & NR)
        'close file
            wbkOld.Close False
        'Next row
            NR = Range("A" & Rows.Count).End(xlUp).Row + 1
        'move file to "imported" folder
            Name fPath & fName As fPathDone & fName         'optional
        'ready next filename
            fName = Dir
    Loop

'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'restores user's original working path
    ChDir OldDir
End Sub

I'm thinking the MasterCombine being in the same folder may explain why it appeared to be working all the way til the end and then suddenly everything disappeared. Hehe, that would be frustrating.