Sub ProcessFiles()
Dim FSO As Object
Dim sFolder As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim this As Workbook
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set this = ActiveWorkbook
sFolder = "D:\Test"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)
Set Files = Folder.Files
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=file.Path
this.Worksheets.Add.Name = "File" & cnt
With ActiveWorkbook
.Worksheets(1).Range("A2:Z500").Copy _
Destination:=this.Worksheets(1).cells(i,"A")
.Close
End With
i= i + 500
End If
Next file
End If ' sFolder <> ""
End Sub