Code fonctionnant uniquement dans son fichier source

Bonjour à tour,

Je dispose d'un code que je n'arrive pas à copier dans un nouveau classeur (celui-ci bug) mais je n'arrive pas à comprendre pourquoi, pouvez-vous m'aider svp? Ce code me permet de lister des fichiers *.xsl* contenant le mot Devis à partir d'une racine de dossier source qui se trouve dans la cellule B2 de la feuil

Public ListeDoss() As String

Sub ChercheDoss(Chemin1 As String)
Dim Ligne As Long, Nom As String
    Ligne = Range("A65536").End(xlUp).Row + 1
    On Error GoTo Err1
    Nom = Dir(Chemin1 & "\*" & Range("Texte").Value & "*" & Range("Ext").Value)

    If Nom <> "" Then
        Cells(Ligne, 1).Value = Chemin1 & "\" & Nom
        Cells(Ligne, 2).Value = Nom
        ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(Ligne, 3), Address:=Chemin1 & "\" & Nom, TextToDisplay:=Nom

        Do
            Ligne = Range("A65536").End(xlUp).Row + 1
            Nom = Dir
            If Nom <> "" Then
                Cells(Ligne, 1).Value = Nom
                Cells(Ligne, 2).Value = Nom
                ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(Ligne, 3), Address:=Chemin1 & "\" & Nom, TextToDisplay:=Nom

            End If
        Loop Until Nom = ""
    End If
Err1:

End Sub

Sub ChercheTout()
Dim Chemin As String, i As Long
    Range("A7:C65536").Clear
    Chemin = Range("Doss").Value
    LanceListe Chemin
    For i = 1 To UBound(ListeDoss)
        ChercheDoss ListeDoss(i)
    Next i
End Sub

Sub ListeArborescence(Dossier As String)
Dim fs, sousdoss
    Set fs = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    For Each sousdoss In fs.getfolder(Dossier).subfolders
        ReDim Preserve ListeDoss(1 To UBound(ListeDoss) + 1)
        ListeDoss(UBound(ListeDoss)) = sousdoss.Path
        ListeArborescence sousdoss.Path
    Next sousdoss
    On Error GoTo 0
    Set fs = Nothing
End Sub

Sub LanceListe(Dossier As String)
    ReDim ListeDoss(1 To 1)
    ListeDoss(1) = Dossier
    ListeArborescence Dossier
End Sub

Bonjour,

as tu une cellule nommée ""texte" et une autre nommée "ext" et la troisième nommée "doss" ?

chacune contient donc le texte à chercher/l'extension du fichier/ le dossier où chercher ...

P.

Parfait, j'avais donc oublié l’essentiel.

Merci

Rechercher des sujets similaires à "code fonctionnant uniquement fichier source"