Sub aargh()
    Sheets.Add
    lmf = "c:\Devis\liste.txt"
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.OpenTextfile(lmf)
    r = ts.readall
    ts.Close
    lm = Split(r, vbNewLine)
    Cells(1, 1).Resize(UBound(lm)) = Application.Transpose(lm)
    lfr "c:\Devis\", "*.txt", lm
    Open "resultats.txt" For Output As 1
    i = 1
    While Cells(i, 1) <> ""
        Ligne = Cells(i, 1) & " présent dans "
        j = 2
        sep = ""
        While Cells(i, j) <> ""
            Ligne = Ligne & sep & Cells(i, j)
            If sep = "" Then sep = ", "
            j = j + 1
        Wend
        If j > 2 Then Print #1, Ligne
        i = i + 1
    Wend
    Close 1
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
End Sub

Sub lfr(rep, filtre, lm, Optional n = 0)
    Set fso = CreateObject("scripting.filesystemobject")
    Set rep = fso.getfolder(rep)
    For Each repf In rep.subFolders
        lfr repf, filtre, lm, n + 1
    Next repf
    For Each f In rep.Files
        fn = f.Name
        If f.Name Like filtre Then
            Set ts = fso.OpenTextfile(f.Path)
            Do While ts.AtEndOfStream <> True
            r = ts.readline
            For i = LBound(lm) To UBound(lm)
                If lm(i) <> "" Then
                    lig = i + IIf(LBound(lm) = 0, 1, 0)
                    If InStr(r, lm(i)) <> 0 Then
                        dc = Cells(lig, Columns.Count).End(xlToLeft).Column + 1
                        Cells(lig, dc) = f.Path
                    End If
                End If
            Next i
            Loop
            ts.Close
            Set ts = Nothing
        End If
    Next f
    Set rep = Nothing
    Set fso = Nothing
End Sub