Scan for files in sub folders, then append common cell value to end of summary list

Hello sjanett,

This should make things easier for you. I developed a macro to look for files in the main directory or any number of sub folders by name and type. All the code below can be placed in the same VBA module.

Test1 Macro Code

Sub Test1()

    Dim Files   As Variant
    Dim LastRow As Range
    Dim n       As Long
    Dim Wkb     As Workbook
    
    
        Set LastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)
        
        n = GetFiles("G:\test\", Files, "*.xls*", -1)
        
        For n = 1 To UBound(Files)
            Set Wkb = Workbooks.Open(Files(n))
            Wkb.Worksheets("Sheeet1").Range("C7").Copy
            LastRow.Offset(n, 1).PasteSpecial Paste:=xlPasteAll
            Wkb.Close SaveChanges:=False
        Next n
        
End Sub

Macro to Search for Files

'***************************************************************************************
' Written:  April 02, 2015                                                              )
' Author:   Leith Ross                                                                  )
' Summary:  List files using a filter and search the parent folder and subfolders.      )
'                                                                                       )                                                                  )
' Arguments:                                                                            )
'           Folder                                                                      )
'               This is the path of the parent folder. The ending backslash             )
'               is optional. E.G. "C:\Test\" and C:\Test" are seen the same.            )
'                                                                                       )
'           FileList                                                                    )
'               A variant that will be converted to an 2 x n array that holds           )
'               the Folder paths and File names. This variable must be declared         )
'               prior to calling the function or an error will result.                  )
'                                                                                       )
'           FileFilter (Optional - default is "*.*" all files)                          )
'               This controls the search parameters for the file names and              )
'               extensions. The filter allows the use of wildcards characters           )
'               "*" and "?". Multiple filters can be used at the same time by           )
'               separating them with a semi-colon. E.G, "*.txt;*.csv". This will        )
'               return all TEXT and CSV files.                                          )
'                                                                                       )
'           SubfolderDepth (Optional - default is 0)                                    )
'               = 0 Searches only the Parent folder.                                    )
'               = 1,2,3, etc. Sets the maximum number of subfodlers to search.          )
'               = -1 Searches the parent folder and all the subfolders.                 )
'                                                                                       )
' Return Value:                                                                         )
'           The function returns the total number of files that match the filter.       )
'                                                                                       )
'***************************************************************************************

Global FolderCnt    As Long
Global oShell       As Object

Function GetFiles(ByVal Folder As Variant, ByRef FileList As Variant, Optional ByVal FileFilter As String, Optional SubFolderDepth As Variant) As Long

    Dim Item    As Variant
    Dim LastCnt As Long
    Dim n       As Long
    Dim oFolder As Object
    Dim oItems  As Object
    
        If FileFilter = "" Then FileFilter = "*.*"
        
        If IsMissing(SubFolderDepth) Then SubFolderDepth = 0
        
        If oShell Is Nothing Then Set oShell = CreateObject("Shell.Application")
        
        Set oFolder = oShell.Namespace(Folder)
        
        If oFolder Is Nothing Then Exit Function
        
            Set oItems = oFolder.Items
            
            oItems.Filter 64, FileFilter
            
            If IsEmpty(FileList) Then
                LastCnt = 0
                ReDim FileList(1 To 2, 1 To oItems.Count)
            Else
                LastCnt = UBound(FileList, 2)
                ReDim Preserve FileList(1 To 2, 1 To LastCnt + oItems.Count)
            End If
            
            For Each Item In oItems
                n = n + 1
                FileList(1, LastCnt + n) = oFolder.Self.Path
                FileList(2, LastCnt + n) = Item
            Next Item
            
                If SubFolderDepth <> 0 Then
                    oItems.Filter 32, "*"
                    FolderCnt = FolderCnt + oItems.Count
                    
                    For Each Item In oItems
                        Call GetFiles(Item, FileList, FileFilter, SubFolderDepth - 1)
                    Next Item
                End If
            
        GetFiles = UBound(FileList, 2)
            
End Function