Sub ListaArquivos()
    For Each x In Workbooks
        Debug.Print "Arquivo: " & x.Name
        ListaPlanilhas x
    Next
End Sub
Sub ListaPlanilhas(p)
   For Each x In p.Sheets
        Debug.Print "   Planilha: " & x.Name
        ListaCelulas x
   Next
End Sub
Sub ListaCelulas(p)
    Set ultimacelula = p.Cells(1, 1).SpecialCells(xlLastCell)
    For lin = 1 To ultimacelula.Row
        For col = 1 To ultimacelula.Column
            If p.Cells(lin, col) <> "" Then
               Debug.Print "        (" & lin & "," & col & ") = " & p.Cells(lin, col)
            End If
        Next
    Next
End Sub
--------------------------------------------------------------------------------------
Sub ImprimeArquivos()
    nomearq = ActiveWorkbook.Path & "\listagem.txt"
    Open nomearq For Output As #1
    For Each x In Workbooks
        Print #1, "Arquivo: " & x.Name
        ImprimePlanilhas x
    Next
    Close #1
    Shell "notepad """ & nomearq & """", vbMaximizedFocus
End Sub
Sub ImprimePlanilhas(p)
   For Each x In p.Sheets
        Print #1, "   Planilha: " & x.Name
        ImprimeCelulas x
   Next
End Sub
Sub ImprimeCelulas(p)
    Set ultimacelula = p.Cells(1, 1).SpecialCells(xlLastCell)
    For lin = 1 To ultimacelula.Row
        For col = 1 To ultimacelula.Column
            If p.Cells(lin, col) <> "" Then
               Print #1, "        (" & lin & "," & col & ") = " & p.Cells(lin, col)
            End If
        Next
    Next
End Sub