Loop throughout folder of workbooks and copy a range to another workbook

[holo man]

There is a Folder "Test" in D: drive. This folder has a lot of workbooks with special names. I want to open all workbook one by one and copy a range akin to a2:z500 and transfer it to another workbook. please help!!

[Bob Phillips]

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

[kuuhletz]

Need help asap. I have tracker that contains the following colum A are dates B reference number C status
I want to transfer A and B to the masterfile by month. How will i use the vba? Thanks!