Necesito sacar un rango de celdas de varios archivos iguales pero que están en carpetas y subcarpetas.

Necesito sacar un rango de celdas de varios archivos iguales pero que están en carpetas y subcarpetas. He visto y lo he hecho pero siempre de una carpeta y no de subcarpetas, ¿se puede hacer? Los archivos tienen distintos nombres pero siempre tienen el mismo formato, osea el rango a sacar es g19:k250,

Ejemplo: archivos de nombres distintos biomasa.xls, porosidad.xls que están en una carpeta llamada "resumen" dentro de esa carpeta hay una subcarpeta que se llama "MDF" y adentro de MDF otro archivo que se llama porosidad2.xls de todos los xls debo sacar para analizar los rangos G19: K250 y ponerlos uno debajo de otro.

Esto es lo que hice: pero solo busca de una carpeta:

Sub copia_hojas()
'------------------
'by niko
'------------------
Dim ws As Worksheet, iFile$, iRow&, mFolder$
Set ws = ActiveSheet
ws.Range(ws.[a1], ws.[a1].SpecialCells(11)).Offset(1).Delete xlShiftUp
mFolder = ThisWorkbook.Path & "\resumen de acciones"
iFile = Dir(mFolder & "\*.xls*")
iRow = 2
Do Until iFile = ""
With ws.Cells(iRow, "a").Resize(150, 7)
.Formula = "=if('" & mFolder & "\[" & iFile & "]5porque'!g19 ="""", """" ,'" & mFolder & "\[" & iFile & "]5porque'!g19)"
.Value = .Value
End With
iFile = Dir
iRow = iRow + 150
tope = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
For f = tope To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(f)) = 0 Then Rows(f).EntireRow.Delete
Next
Columns("A:A").WrapText = True
Columns("B:B").WrapText = True
Columns("C:C").WrapText = True
Columns("D:D").WrapText = True
Loop
End Sub

Excelente foro.