Macro searching subfolders for files

[dhugh]

I have a macro that I want to edit. Right now the script works if all files are in the same folder. I need it to search in a directory for subfolders in a certain name range. The directory will not change. The subfolders names change by the last 2 characters. ex: TestCell_20**. I need the script to search just folders of this name type. Then I need the script to collect the data and input the data into the same workbook as its own sheet. Each subfolder contains a *.dat file from which excel will extract data. The code I have is below.

Sub open_files()

Dim name As String
' takes file name that starts with CellDaily_Stand20*.dat and copies it into "name" variable
name = Dir("C:\Documents and Settings\dhugh\My Documents\TestCells\CellDaily_Stand20*.dat")

'loops copying each file as a sheet into Test_Data_Summary workbook

Do

Workbooks.Open Filename:="C:\Documents and Settings\dhugh\My Documents\TestCells\" & name
Workbooks(name).Sheets(1).Copy After:=Workbooks("Test_Data_Summary.xlsm").Sheets(Workbooks("Test_Data_Summary.xlsm").Sheets.Count)
Workbooks(name).Close

name = Dir

Loop Until name = ""


End Sub

Sub gather_info()

Dim i As Integer
Dim s As Integer
Dim n As Integer
Dim y As Integer
Dim m As Integer
Dim tot As Double
Dim name As String

i = Sheets.Count

While name <> "Data Summary" 'loops through all sheets

s = 1 ' s is the row variable
While Sheets(i).Cells(s, 2).Value = 0 'finds first row with a date on the sheet
s = s + 1
Wend

While Sheets(i).Cells(s, 6).Value <> 0 'loops until last date on sheet

'copies month and year of one cell into variables
y = year(Sheets(i).Cells(s, 6).Value)
m = month(Sheets(i).Cells(s, 6).Value)

n = 0 ' n indicates which year the value should be copied under
While Sheets("Data Summary").Cells(6, (4 + 12 * n)).Value <> y 'loops to find correct year in data summary

If Sheets("Data Summary").Cells(6, (4 + 12 * n)).Value = 0 Then 'writes year into data summary
Sheets("Data Summary").Cells(6, (4 + 12 * n)).Value = y
Else:

n = n + 1

If Sheets("Data Summary").Cells(7, (3 + 12 * n)) = 0 Then ' makes new year column in data summary if needed

Sheets("Data Summary").Range("C7:N7").Copy Destination:=Sheets("Data Summary").Cells(7, (3 + 12 * n))
Sheets("Data Summary").Range("C6").Copy Destination:=Sheets("Data Summary").Cells(6, (3 + 12 * n))

End If
End If


Wend

tot = 0 'the monthly total for a test cell
While month(Sheets(i).Cells(s, 6).Value) = m And Sheets(i).Cells(s, 6).Value <> "" 'loops while still the same month

'tests logic to check if the difference between test cell hour values makes sense
If Sheets(i).Cells(s + 1, 17).Value - Sheets(i).Cells(s, 17).Value > 0 And Sheets(i).Cells(s + 1, 17).Value - Sheets(i).Cells(s, 17).Value < 10 Then
tot = tot + Sheets(i).Cells(s + 1, 17).Value - Sheets(i).Cells(s, 17).Value
'adds difference to total for month
End If

s = s + 1

Wend

'copies total into data summary
Sheets("Data Summary").Cells((37 + i - Sheets.Count), (2 + m + 12 * n)).Value = tot

Wend

i = i - 1
name = Sheets(i).name

Wend


End Sub