Code: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
Bookmarks