Can I import data from 500 files to one sheet using a macro?

Sub IndexFiles()
    
Sheets.Add
ActiveSheet.Name = "Files"

With Application.FileSearch
    
' If you leave the lookin line out it will display this
' list for the current active directory.
    .LookIn = "U:\scarab\Production Information\FOLDERS\STOCKTAKE\2006 Stock Take\Freetask\Stock Take\"
    .FileType = msoFileTypeAllFiles
    .SearchSubFolders = True
    .Execute
End With

    
cnt = Application.FileSearch.FoundFiles.Count

For i = 1 To cnt
    rng = "A" & i
    Range(rng).Value = Application.FileSearch.FoundFiles.Item(i)
Next
Sheets("Headings").Select
End Sub

Sub ScanData()
'
' Macro1 Macro
' Macro recorded 21/05/2003 by Stephen Hoadley
'

'
    Sheets("Files").Select
    Range("a1").Select
    
    r = Range("A65536").End(xlUp).Offset(0, 0).Row
    For counter = 1 To r
 
    
    y = ActiveCell
    Workbooks.Open Filename:=y, UpdateLinks:=0
    Sheets("FREETASK").Select
    Range("A2").Select
    x = ActiveWorkbook.Name
    Range("A1").Select
    Windows("Index Merge Stock Take.xls").Activate
    Sheets.Add
    ActiveSheet.Name = x
    Windows(x).Activate
    Cells.Select
    Selection.Copy
    Windows("Index Merge Stock Take.xls").Activate
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    
    
    'ActiveSheet.Paste
    Range("A1").Select
    Columns("A:A").Select
    Selection.Font.Bold = False
    With Selection
        .HorizontalAlignment = xlLeft
    End With
    Range("A1").Select
    
    Windows(x).Activate
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Close
    Range("B65536").End(xlUp).Offset(1, -1).Select
    ActiveCell.Offset(-1, 8).Range("A1").Select
    a = ActiveCell.Address
    'Sheets("Headings").Select
    'Range("G4:I4").Select
    'Selection.Copy
    'Sheets(x).Select
    'Range("G1").Select
    'ActiveSheet.Paste
    'If a = "$I$1" Then a = "$I$2"
    'Selection.AutoFill Destination:=Range("G1", a), Type:=xlFillDefault
    'Application.CutCopyMode = False
    Range("a1").Select
    Sheets("Files").Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Next counter
    Sheets.Add
    ActiveSheet.Name = "Merge"
    Sheets("Headings").Select
    Range("F8").Select
End Sub

Sub Merge()
Dim ws As Worksheet
'Application.ScreenUpdating = False
'loop thrue all sheet
'For Each Sheet In Sheets
Sheets("Merge").Select


ActiveSheet.UsedRange.Offset(0).Clear
For Each ws In ActiveWorkbook.Worksheets
'skip active sheet
If ws.Name <> ActiveSheet.Name Then
If ws.Name = "Files" Then Exit For

'If Sheet.Name <> ActiveSheet.Name Then
'Sheet.Range("A1:C10").Copy
ws.UsedRange.Offset.Copy
'find last empty cell in column A
Range("B65536").End(xlUp).Offset(1, -1).Select
'paste the copied data

    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False





'ActiveSheet.Paste
End If
Next
'Application.ScreenUpdating = True

'100
Range("a1").Select
Application.CutCopyMode = False
    Cells.Select
    'Cells.EntireColumn.AutoFit
    Range("A1").Select
Sheets("Headings").Select
End Sub

Option Explicit
Sub test()
Dim FilePath    As String
Dim DestWb      As Workbook
Dim i           As Integer
Dim SourceWb    As Workbook
Dim SourceSht   As Worksheet
Dim CopyRng     As Range
Dim DestRng     As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

FilePath = "C:\Test\" 'change to suit
Set DestWb = ThisWorkbook
Set DestRng = DestWb.Worksheets(1).Range("A2")

    With Application.FileSearch
        .NewSearch
        .LookIn = FilePath
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                Set SourceWb = Workbooks.Open(Filename:=.FoundFiles(i), updatelinks:=0)
                Set SourceSht = SourceWb.Worksheets(1) 'adjust the sheet
                Set CopyRng = SourceSht.Range("A2:E100") 'adjust the range
                
                CopyRng.Copy Destination:=DestRng
                SourceWb.Close False
                Set DestRng = DestWb.Worksheets(1).Range("A65536").End(xlUp).Offset(1)
            Next i
        End If
    End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

CopyRng.Copy Destination:=DestRng

CopyRng.Copy
DestRng.PasteSpecial xlPasteValues