take data from different workbooks and sheets

Hi all,

I would need help with following problem ... I have structure on disk where are folders with years, than subfolders with months and in each subfolder can be workbook with several sheets. I need to go thru all folders/subfolders/workbooks/sheets.

To find folders/subfolders/workbooks is not the problem. Problem is to go thru all sheets and pick-up the value from each sheet.

Function nazevsouboru(a As String) As String
    j = 0
    Do While Mid(a, Len(a) - j, 1) <> "\" And Mid(a, Len(a) - j, 1) <> "/"
        j = j + 1
    Loop
    nazevsouboru = Right(a, j)
End Function




Sub listfolders()

    Dim fs As Object
    Dim soubor, soubor_dod As Object
    Dim a As String
    Dim fl1, fl2, fl3, fl4, fl5, fl6, fl7 As Object
    Dim x As Long
    Dim n As Long
    Dim Text, Textline, datum As String
                    
    startfolder = Range("B6").Value

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fl1 = fs.GetFolder(startfolder)
 
    i = 0
    For Each fl2 In fl1.SubFolders 
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set fl3 = fs.GetFolder(fl2.path)

        For Each fl4 In fl3.SubFolders 
            If UCase(fl2.Name) <> "ARCHIV" Then
                Set fl5 = fs.GetFolder(fl4.path)
                For Each soubor In fl5.Files
                    If UCase(Mid(soubor.Name, 1, 5)) = "AKČNÍ" Or UCase(Mid(soubor.Name, 1, 5)) = "AKCNI" Or UCase(Mid(soubor.Name, 1, 2)) = "AP" Then

                        Range("A21").Offset(i, 0).Value = "=HYPERLINK(""" & fl2 & """,""" & fl2.Name & """)"   ' write years
                        Range("B21").Offset(i, 0).Value = "=HYPERLINK(""" & fl4 & """,""" & fl4.Name & """)"   ' write months
                        a = soubor
                        Range("C21").Offset(i, 0).Value = "=HYPERLINK(""" & soubor & """,""" & nazevsouboru(a) & """)"   ' write workbook

                        '========== DOESN'T WORK
                        For j = 2 To "founded workbook.sheets.count"  'not pick up data from 2 first sheets
                                  Range("D21").Offset(i, 0).Value = founded workbook.each sheet.Range("A5").Value
                                  Range("E21").Offset(i, 0).Value = founded workbook.each sheet.Range("C8").Value 'for example
                                  



                        Next j
                        '====================

                        i = i + 1                        
                   
                    End If
                Next
            End If
        Next
        
    Next

Thank You very much in advance for Your help.

Greetings

Martin