VBscript or Macro that will combine multiple excel files into one file

Sub OneBigWorkbook()
'Puts all the Excel files in a user-specified folder into a single workbook. Just the first worksheet is taken _
    from each of these workbooks.
'Note: you may encounter a fatal error if the number of unique combinations of cell formats exceeds 4000. _
    There is no known cure for this error! If you encounter this error, split the task up into multiple workbooks.
'The worksheets are appended into the active workbook--so you may want to open a blank workbook just for _
    that purpose. Any blank worksheets initially in that workbook are deleted.
'The worksheets are sorted in alphabetical order to make things easier to find.
Dim wb As Workbook, wbBig As Workbook
Dim ws As Worksheet
Dim f As String, flPath As String
Dim i As Long, j As Long
'If MsgBox("This workbook will be saved after every five files are added. Have you saved it to the desired location?", _
 '   vbYesNo) = vbNo Then Exit Sub
'f = Application.GetOpenFilename("Microsoft Office Excel files, *.xls", , _
 '   "Please pick any file from the desired folder, then click the 'Open' button.")
'If f = "FALSE" Or f = "" Then Exit Sub
Application.Workbooks.Open ("file path")
 
'Code runs faster if screen updating is turned off, alert messages aren't displayed, and event macros don't run
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.DisplayStatusBar = True
'On Error Resume Next
 
Set wbBig = ActiveWorkbook
 
flPath = Left(f, InStrRev(f, "\"))
f = Dir(flPath & "*.xls")
Do
    If f = "" Then Exit Do      'If f="", then all done with the folder
    i = i + 1 'Number of worksheets added to the workbook
    Application.StatusBar = "Processing file number " & i
    Set wb = Workbooks.Open(flPath & f)
    Set ws = wb.Worksheets(1)
    ws.Copy Before:=wbBig.Worksheets(1)
    wbBig.Worksheets(1).UsedRange.Value = ws.UsedRange.Value    'This statement needed if any cell contains >255 characters
    wbBig.Worksheets(1).Name = Left(wb.Name, Len(wb.Name) - 4)
    wb.Close SaveChanges:=False
    
    If i = 2 Then   'Delete the blank worksheets
        For Each ws In wbBig.Worksheets
            If ws.UsedRange.Cells.Count = 1 Then ws.Delete
        Next
    End If
    If Err <> 0 Then
        Err.Clear
        i = i - 1
        j = j + 1
    End If
    
    f = Dir
   ' If (i Mod 5) = 0 Then wbBig.Save        'You may want to comment out this statement if using Excel 2007
Loop
 
'Alphabetize the worksheets
'SortWorksheets
 
Errhandler:
    If Not wb Is Nothing Then wb.Close
     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
     Application.EnableEvents = True
     Application.StatusBar = False       'Restore normal behavior to the status bar
     On Error GoTo 0
     If j <> 0 Then MsgBox "There were problems adding worksheets from " & j & " files"
 End Sub
 
 
 'Sub SortWorksheets()
 
 'End Sub
'Sorts worksheets in alphabetical order. Taken from Chip Pearson http://www.cpearson.com/excel/sortws.htm
'Dim n As Integer
'Dim M As Integer
'Dim FirstWSToSort As Integer
'Dim LastWSToSort As Integer
'Dim SortDescending As Boolean
 
'SortDescending = False
 
'If ActiveWindow.SelectedSheets.Count = 1 Then
 '   FirstWSToSort = 1
  '  LastWSToSort = Worksheets.Count     'Subtract 1 from .Count if you don't want to sort the last worksheet
'Else
 '   With ActiveWindow.SelectedSheets
  '      For n = 2 To .Count
   '         If .Item(n - 1).Index <> .Item(n).Index - 1 Then
    '            MsgBox "You cannot sort non-adjacent sheets"
     '           Exit Sub
      '      End If
       ' Next n
       ' FirstWSToSort = .Item(1).Index
       ' LastWSToSort = .Item(.Count).Index
    ' End With
'End If
 
'For M = FirstWSToSort To LastWSToSort
 '   For n = M To LastWSToSort
  '      If SortDescending = True Then
   '         If UCase(Worksheets(n).Name) > UCase(Worksheets(M).Name) Then
    '            Worksheets(n).Move Before:=Worksheets(M)
     '       End If
      '  Else
       '     If UCase(Worksheets(n).Name) < UCase(Worksheets(M).Name) Then
        '       Worksheets(n).Move Before:=Worksheets(M)
         '   End If
'        End If
 '    Next n
'Next M
'End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112: