Here's the code:
Function MergeExcelFiles()
Dim xlApp As Excel.Application
Dim xlApp2 As Excel.Application
Dim xlWb As Object
Dim xlWb2 As Object
Dim xlWs As Object
Dim xlWs2 As Object
Dim lngRow As Long
Dim i, j As Integer
Dim sGridOrder As String
Dim sGridOrder2 As String
Dim sFileNumSplit As Variant
Dim sFileNumSplit2 As Variant
j = fgFileOrder.Rows - 1
For i = 1 To j
If i = 1 Then
Set xlApp = CreateObject("Excel.Application"

xlApp.AskToUpdateLinks = False
xlApp.DisplayAlerts = False
sGridOrder = fgFileOrder.TextMatrix(i, 0)
Set xlWb = xlApp.Workbooks.Open(Dir1.Path & "\" & sGridOrder)
sFileNumSplit = Split(sGridOrder, ".", , vbTextCompare)
Set xlWs = xlWb.Worksheets(sFileNumSplit(0)) 'sFileNumSplit="excelfile.xls"
Else
If i > 1 Then
Set xlApp2 = CreateObject("Excel.Application"

xlApp2.AskToUpdateLinks = False
xlApp2.DisplayAlerts = False
sGridOrder2 = fgFileOrder.TextMatrix(i, 0)
Set xlWb2 = xlApp2.Workbooks.Open(Dir1.Path & "\" & sGridOrder2)
sFileNumSplit2 = Split(sGridOrder2, ".", , vbTextCompare)
Set xlWs2 = xlWb2.Worksheets(sFileNumSplit2(0))
Workbooks(1).Sheets(1).Copy After:=xlWb.Sheets(sFileNumSplit(0))
End If
If i > 1 Then
xlWb.Close savechanges:=True
xlWb2.Close savechanges:=True
End If
End If
Next
Set xlWb = Nothing
Set xlWb2 = Nothing
Set xlWs = Nothing
Set xlWs2 = Nothing
Set xlApp = Nothing
Set xlApp2 = Nothing
End Function