VBA extract sheet data from multiple subfolders into master

[devofish]

Hello all. I've been searching for several days and trying different techniques with no apparent success, so I'm hoping someone can see what I have and have a better solution. The most comprehensive, succinct, and successful code I've been able to construct with the help of many, is the example below, however, the code doesn't look in subfolders and there are a couple of tweaks that I haven't been able to configure.

My data sets are ASCII coded (basically you can see all data is read within column 1). All data are space delimited. The header information can remain intact, but once transferred it needs to autofill to lastrow of each relative data set. I've got some code that can delimit out data sets and remove the ASCII headers, so I think I can deal with delimiting it after all the files are transferred, but why isn't it looping through the sub-directories?

[COLOR=#333333]Sub Consolidate()[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">
    Dim Fs As Object 'FileSystem
    Dim d As Object 'Folder
    Dim Fx As Object 'Subfolder
    Dim file As Object 'File
    Dim PathName As String
    Dim iRow As Long 'next available row index of destination worksheet
    Dim LastRow As Long 'last row of source worksheet
    Dim wbSource As Workbook, wsMaster As Worksheet
    
    Set wsMaster = ThisWorkbook.Sheets("Master") 'sheet data will be compiled into

    With wsMaster 'data destination worksheet
        Set Fs = CreateObject("Scripting.FileSystemObject")
        Set d = Fs.GetFolder("Z:\Operations\Chupacabra\Data\")
        iRow = 2
        
        For Each Fx In d.SubFolders 'loop through subfolders
            For Each file In Fx.Files 'loop through files
                If file.Name Like "*dq1000d.las*" Then
                    PathName = Fx.Name & "\" & file.Name
                    Workbooks.Open d.Path & "\" & PathName
                    Application.StatusBar = "Processing " & PathName
                    LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1 'Find & copy to last row having data in column A
                    Range("A132:A" & LastRow).Copy .Range("A" & iRow)    'this original data is space delmited
                    Range("A13").Copy .Range("B" & iRow)                 'header data needs to remain intact & autofill
                    Range("A12").Copy .Range("C" & iRow)                 'header data needs to remain intact & autofill
                    Range("A23").Copy .Range("D" & iRow)                 'header data needs to remain intact & autofill
                    iRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1   'Next row
                    ActiveWorkbook.Close savechanges:=False
                End If
                iRow = iRow + LastRow
            Next file
        Next Fx
    End With </code>[COLOR=#333333]End Sub[/COLOR]

 

[devofish]

possible solution:

https://www.excelforum.com/excel-pr...tiple-subfolders-into-master.html#post4741906

I'm waiting until the end of the day to run the code.