XL 2019 Listing fichiers dans dossier

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Julien_m

XLDnaute Junior
Bonjour à tous,

j'ai trouvé sur internet un code vba (https://excel.developpez.com/faq/?page=FichiersDir) qui permet presque de faire ce que je veux.
Au départ il liste verticalement l'ensemble des fichiers dans un dossier.
J'ai modifié ça en le faisant lister horizontalement mais j'aimerais qu'il s'arrête après 2 fichiers par exemple et qu'il ne déborde pas sur les colonnes plus loin.
Une fois qu'il m'a listé les 2 fichiers du premier chemin en ligne 1, qu'il passe à la ligne 2 avec un nouveau chemin d'accès.

J'ai essayé de changer ça en boucle for mais je n'arrive pas à convertir la boucle loop en boucle for... 😕

Si quelqu'un peut m'éclaircir sur ce point je suis preneur 🙂

à bientôt,

Ju
 

Pièces jointes

Solution
Il manquait le test If r <> "" Then :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                If Trim(CStr(r)) <> "" Then
                    fichier = Dir(CStr(r))
                    With Intersect(.Columns(col2(i)), r.EntireRow)
                        .ClearContents 'RAZ
                        n = 0
                        While fichier <> "" And n < .Count...
Bonjour Julien_m,

Les bonnes macros :
VB:
Sub Horizontal()
Dim Dossier As String, Fichier As String, i As Integer
Dossier = "C:\Users\julie\OneDrive - NGE\AUTRE\"
Fichier = Dir(Dossier & "*.xls*")
i = 1
Do While Fichier <> "" And i < 3
    i = i + 1
    Sheets("Feuil1").Cells(1, i) = Fichier
    Fichier = Dir
Loop
End Sub
VB:
Sub Horizontal2()
Dim Dossier As String, Fichier As String, i As Integer
Dossier = "C:\Users\julie\OneDrive - NGE\AUTRE\"
Fichier = Dir(Dossier & "*.xls*")
For i = 2 To 3
    If Fichier = "" Then Exit For
    Sheets("Feuil1").Cells(1, i) = Fichier
    Fichier = Dir
Next
End Sub
Edit : si l'on veut tous les types de fichiers remplacer "*.xls*" par "*.*"

A+
 
Dernière édition:
Bonjour,

Autre proposition
VB:
Sub Horizontal2()
    Dim Dossier As String, Fichier As String, Lig As Integer, col As Integer
    Dossier = "C:\Users\julie\OneDrive - NGE\AUTRE\"
    Fichier = Dir(Dossier)
    col = 1
    Lig = 1
    Do While Fichier <> ""
        If Fichier <> "" Then
            Sheets("Feuil1").Cells(Lig, col) = Fichier
            If col = 2 Then
                col = 1
                Lig = Lig + 1
            Else
                col = col + 1
            End If
            Fichier = Dir
        End If
    Loop
End Sub

Cdlt
 
Bonjour Rouge,

Pour lister tous les fichiers dans les 2 colonnes B:C ceci est simple :
VB:
Sub Horizontal()
Dim Dossier As String, Fichier As String, n As Integer
Dossier = "C:\Users\julie\OneDrive - NGE\AUTRE\"
Fichier = Dir(Dossier)
With Sheets("Feuil1").[B:C]
    While Fichier <> ""
        n = n + 1
        .Cells(n) = Fichier
        Fichier = Dir
    Wend
    .Rows(Application.Ceiling(n / 2, 1) + 1 & ":" & .Rows.Count).ClearContents 'RAZ en dessous
End With
End Sub
A+
 
Merci à vous deux pour vos réponses.

J'ai essayé ce que tu m'as proposé job75, ça marche nickel.

Par contre (😅), j'essaie maintenant d'en assembler plusieurs dans une seule macro et ça me dit qu'il y a une erreur au deuxième Fichier=Dir....

VB:
Sub Horizontal()

Dim Dossier As String, Fichier As String, i As Integer, derlig As Integer

    derlig = Sheets("Feuil1").Range("Nombre_ligne_max") + 6

'Zone 1

    For j = 7 To derlig

        Dossier = Cells(j, 15)

        Fichier = Dir(Dossier)

        i = 16

            If Fichier = "" Then Exit For

            Sheets("Feuil1").Cells(j, i) = Fichier

            Fichier = Dir

    Next


'Zone 2

    For j = 7 To derlig

        Dossier = Cells(j, 21)

        Fichier = Dir(Dossier)

        i = 22

            If Fichier = "" Then Exit For

            Sheets("Feuil1").Cells(j, i) = Fichier

            Fichier = Dir

    Next

'Zone 3

    For j = 7 To derlig

        Dossier = Cells(j, 27)

        Fichier = Dir(Dossier)

        For i = 28 To 29

            If Fichier = "" Then Exit For

            Sheets("Feuil1").Cells(j, i) = Fichier

            Fichier = Dir

        Next

    Next

'Zone 4

    For j = 7 To derlig

        Dossier = Cells(j, 42)

        Fichier = Dir(Dossier)

        For i = 43 To 47

            If Fichier = "" Then Exit For

            Sheets("Feuil1").Cells(j, i) = Fichier

            Fichier = Dir

        Next

    Next

End Sub

Pour expliquer :
Chemin dossier 1 : colonne P (colonne n°15)
résultats en : Q (16)
Chemin dossier 2 : colonne V (21)
résultats en : W (22)
Chemin dossier 3 : colonne AB (27)
résultats en : AC & AD (28 & 29)
Chemin dossier 4 : colonne AQ (42)
résultats en : AR à AV (43 à 47)

le deuxième Fichier=Dir ne peut pas écraser le résultat du premier ?

A+
 
Dernière édition:
D'après ce que je comprends :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                fichier = Dir(r)
                With Intersect(.Columns(col2(i)), r.EntireRow)
                    .ClearContents 'RAZ
                    n = 0
                    While fichier <> "" And n < .Count
                        n = n + 1
                        .Cells(n) = fichier
                        fichier = Dir
                    Wend
                End With
            Next
        End If
    Next
End With
End Sub
 
D'après ce que je comprends :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                fichier = Dir(r)
                With Intersect(.Columns(col2(i)), r.EntireRow)
                    .ClearContents 'RAZ
                    n = 0
                    While fichier <> "" And n < .Count
                        n = n + 1
                        .Cells(n) = fichier
                        fichier = Dir
                    Wend
                End With
            Next
        End If
    Next
End With
End Sub
erreur au premier fichier = Dir(r)
 
Il manquait le test If r <> "" Then :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                If Trim(CStr(r)) <> "" Then
                    fichier = Dir(CStr(r))
                    With Intersect(.Columns(col2(i)), r.EntireRow)
                        .ClearContents 'RAZ
                        n = 0
                        While fichier <> "" And n < .Count
                            n = n + 1
                            .Cells(n) = fichier
                            fichier = Dir
                        Wend
                    End With
                End If
            Next
        End If
    Next
End With
End Sub
 
Dernière édition:
Il manquait le test If r <> "" Then :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                If r <> "" Then
                    fichier = Dir(r)
                    With Intersect(.Columns(col2(i)), r.EntireRow)
                        .ClearContents 'RAZ
                        n = 0
                        While fichier <> "" And n < .Count
                            n = n + 1
                            .Cells(n) = fichier
                            fichier = Dir
                        Wend
                    End With
                End If
            Next
        End If
    Next
End With
End Sub
idem au second Fichier = dir 😅
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
582
Retour