XL 2019 Listing fichiers dans dossier

Créer une discussion
Répondre

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 !

S'inscrire
J

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
job75
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...
Trier par date Trier par votes
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:
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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+
 
Vote positif 0 Vote négatif
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:
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
job75 à dit:
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
Cliquez pour agrandir...
erreur au premier fichier = Dir(r)
 
Vote positif 0 Vote négatif
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:
Vote positif 0 Vote négatif
Solution
job75 à dit:
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
Cliquez pour agrandir...
idem au second Fichier = dir 😅
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

T
  • Résolu(e)
XL 2010 VAB - Lister et renommer fichiers en bloc
Réponses
6
Affichages
490
tchi456
T
M
  • Question Question
XL 2021 Creation VBA copie de differents fichiers dans différents dossiers
Réponses
5
Affichages
602
patricktoulon
patricktoulon
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
510
JJ69
J
cathodique
  • Résolu(e)
XL 2010 Problème màj feuilles depuis fichiers CSV
2
Réponses
23
Affichages
3 K
cathodique
cathodique
D
  • Question Question
Microsoft 365 Couper Coller Fichiers en VBA
Réponses
3
Affichages
864
patricktoulon
patricktoulon
W
  • Question Question
XL 2016 Joindre par mail un fichier.pdf personnalité selon le prénom trouvé dans le titre du pdf
Réponses
10
Affichages
959
TooFatBoy
TooFatBoy
N
  • Question Question
XL 2016 Macro chargement liste arborescence, copier coller fichiers
Réponses
9
Affichages
745
Nermal64
N
Q
  • Résolu(e)
Microsoft 365 Exécutions directes différentes vs "pas à pas"
Réponses
2
Affichages
580
Quentin2106
Q
Darkopsix
  • Résolu(e)
XL 2021 Récupérer des données de fichiers dons les noms sont renseignés dans des cellules
Réponses
2
Affichages
683
Darkopsix
Darkopsix
L
  • Résolu(e)
Microsoft 365 Décompte via plusieurs fichiers CSV
Réponses
12
Affichages
767
WTF
WTF
G
  • Question Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
731
GClaire
G
patricktoulon
  • Résolu(e)
XL 2013 un dossier qui ne veut pas etre supprimer avant la fermeture du fichier
2
Réponses
18
Affichages
1 K
patricktoulon
patricktoulon
Usine à gaz
  • Résolu(e)
Microsoft 365 lister des fichiers
2
Réponses
19
Affichages
2 K
Usine à gaz
Usine à gaz
O
  • Question Question
XL 2010 suppression fichiers excel vba
Réponses
9
Affichages
656
Oneida
Oneida
F
  • Question Question
XL 2019 Problème Macro Excel vers internet
Réponses
11
Affichages
1 K
Staple1600
Staple1600
A
  • Question Question
XL 2010 Date dans fichier pour impression pdf
Réponses
2
Affichages
1 K
Aldonanou
A
A
  • Question Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
1 K
A-F
A
J
  • Résolu(e)
XL pour MAC Chemin d'accès dans VBA macro d'impression PDF
Réponses
10
Affichages
3 K
kiki29
kiki29
V
  • Question Question
Microsoft 365 Recherche de répertoire à partir d'une URL
Réponses
3
Affichages
902
fanch55
fanch55
B
  • Résolu(e)
XL 2019 Appliquer une macro à plusieurs fichiers d'un dossier - Débogage ?
Réponses
9
Affichages
1 K
Bastien43
B
Retour