Bruno, my apologies for taking so long to try your code. If you do not wish to pursue this after all this time has passed, I understand.

The code on the second line "Dim FS As New FileSystemObject"
is giving me a "user defined type not defined" error:

These two lines under "CheckFileName" are showing in red when I paste the code:

Set SourceRange =

and

TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)




[code]
Public Sub CollectFromEverywhere()
Dim FS As New FileSystemObject
Dim FS_subFolders As Object
Dim FS_Folders As Object, SourceFile As Object
Dim FS_Files As Object, xlApp As New Excel.Application
Dim colFolders_1 As Collection, SourceRange As Range
Dim colFolders_2 As Collection, n As Long, m As Long
Dim i, j, k, h As Long, NumRow As Integer, NumCol As Integer
Dim TargetRange As Range, SourceFolder As String

' Definitions ---------------------------
SourceFolder = "S:\Accounting\film"
NumRow = 100
NumCol = 8
Set TargetRange = [MasterSheet!A1]
' ---------------------------------------

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set colFolders_1 = New Collection
colFolders_1.Add SourceFolder
On Error GoTo FolderNotFound
Set FS_Folders = FS.GetFolder(SourceFolder)
On Error GoTo 0
Set FS_Files = FS_Folders.Files
For Each k In FS_Files
GoSub CheckFileName
Next

Start:
'------
Set colFolders_2 = colFolders_1
Set colFolders_1 = New Collection
For Each i In colFolders_2
Set FS_Folders = FS.GetFolder(i)
Set FS_subFolders = FS_Folders.SubFolders
For Each j In FS_subFolders
Set FS_Folders = FS.GetFolder(j.Path)
colFolders_1.Add j.Path
Set FS_Files = FS_Folders.Files
DoEvents
For Each k In FS_Files
GoSub CheckFileName
Next k
Next j
Next i
If colFolders_1.Count 0 Then
GoTo Start
End If

Exit_Sub:
ThisWorkbook.Save
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

CheckFileName:
If InStr(1, k.Name, "Source") And Right(k, 4) = ".xls" Then
h = h + 1
Set SourceFile = xlApp.Workbooks.Open(k)
Set SourceRange =
SourceFile.Worksheets("CASH").Range ("A1:H100")
For n = 1 To NumRow
For m = 1 To NumCol
TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)
Next
Next
SourceFile.Close
End If
Return

FolderNotFound:
MsgBox "Err. " & Err.Number & " - " & _
Err.Description & vbCrLf & vbLf & _
"Folder: " & UCase(SourceFolder) & _
" -- Not Found."
Resume Exit_Sub

End Sub

Royzer has brought this to us :
Royzer;1603941 Wrote:
Thank you, Bruno. I will try this when I return to work Thursday.

Roy

Bruno, my apologies for taking so long to try your code. If you do not
wish to pursue this after all this time has passed, I understand.

The code on the second line "Dim FS As New FileSystemObject"
is giving me a "user defined type not defined" error:

You need the reference:
MicrosoftScriptingRuntime

These two lines under "CheckFileName" are showing in red when I paste
the code:

Set SourceRange =
Set SourceRange = SourceFile.Worksheets("CASH").Range("A1:H100")
To be written all in one line!

TargetRange(n + NumRow * (h - 1), m) = SourceRange(n,
m)
TargetRange(n + NumRow * (h - 1), m) = SourceRange(n, m)
To be written all in one line!

Bruno

Thank you for your help, Bruno. I made the changes you suggested and now the code runs until it gets to this line in the CheckFileName section:

SourceFile.Worksheets("CASH").Range ("A1:H100")

It gives the error: "Object doesn't support this property or method"

Hi

As you have already declared the Sourcefile as

Set SourceFile = xlApp.Workbooks.Open(k)

You should only need to use the following:

Set SourceRange = SourceFile.Range("A1:H100")

HTH
Mick.

Thanks, Mick. The code ran but I got jammed with notifications from each of the 32 files I was pulling data from asking me if I wanted to save the file before closing. Is there something I can add to avoid that?

You could try the following:

In as much as it is purely asthetic, I prefer to use the following which
keeps everything together in a nice collection rather than address each
line of:

Application This, or Application That, you can use the With statement
and include each point.

You would use the following to turn off.

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.AlertBeforeOverwriting = False
End With

Then use this to reset them when exiting the routine.

With Application
.Calculation = = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
End With


HTH
Mick.

Thanks, Mick. I appreciate the help.