Ouvrir plusieurs fichiers Excel dans un dossier

Bonjour tout le monde,

J'ai un fichier synthèse et je dois ouvrir plusieurs fichiers Excel qui se trouve dans un dossier que j'ai appelé "TEST".

J'arrive à ouvrir un dossier mais je ne sais pas comment faire pour boucler sur tous les fichiers du dossier.

Pour mon test j'ai un fichier Excel que j'ai appelé "Personne A" et un deuxième que j'ai appelé "Personne B"

Voila le petit bout de code que j'ai :

Public Sub ouvrir_fichier()

Dim Nom_Fichier As String

Nom_Fichier = "Personne A"

Workbooks.Open "d:\Lcasado\Desktop\TEST\" & Nom_Fichier & ".xlsx"

End Sub

En fait l'objectif c'est de rapatrier les données de tous les fichiers du dossier dans mon fichier Excel Synthèse.

Merci.

J'ai réussi à avancer mais la le problème c'est que ça fonctionne pour un unique fichier et par plusieurs fichier dans un dossier.

Je pense qu'il faut ajouter une boucle IF quelque part mais je ne sais pas où ^^

Option Explicit

Public Sub ouvrir_fichier()

'Enleve les fenetres de demande
Application.DisplayAlerts = False

'Declaration des variable
Dim nom_fichier As String
Dim fichier_synthese As String

nom_fichier = "Personne A"
fichier_synthese = "Synthèse"

'Ouverture du fichier
Workbooks.Open "d:\Lcasado\Desktop\TEST\" & nom_fichier & ".xlsx"

'Activation de la feuille 2
Sheets("Evaluations").Activate

'Sélection des cellules A2 à F18
Range("A2:F18").Copy

Workbooks(fichier_synthese).Activate
Sheets("Synthèse").Activate
Range("A1").Select
ActiveSheet.Paste
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Range("A1").Select
Workbooks(nom_fichier).Close SaveChanges:=False
Workbooks(fichier_synthese).Activate
Sheets("Synthèse").Activate
Range("A1").Select
Range("A" & Rows.Count).End(xlUp).Select
ActiveCell.Offset(2, 0).Select

End Sub

Bonjour TeamG1,

A tester :

Option Explicit

Public Sub ouvrir_tous_les_fichiers()

    'Enleve les fenetres de demande
    Application.DisplayAlerts = False

    'Declaration des variables
    Dim nom_fichier As String
    Dim fichier_synthese As String
    Dim dossier As String
    Dim wb As Workbook

    fichier_synthese = "Synthèse"
    dossier = "d:\Lcasado\Desktop\TEST\"

    'Boucle sur tous les fichiers dans le dossier
    nom_fichier = Dir(dossier & "*.xlsx")
    Do While nom_fichier <> ""
        'Ouverture du fichier
        Set wb = Workbooks.Open(dossier & nom_fichier)

        'Activation de la feuille 2
        wb.Sheets("Evaluations").Activate

        'Sélection des cellules A2 à F18 et copie
        Range("A2:F18").Copy

        'Coller dans le fichier synthese
        With Workbooks(fichier_synthese).Sheets("Synthèse")
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
        End With

        'Fermeture du fichier ouvert
        wb.Close SaveChanges:=False

        'Obtenir le nom du prochain fichier
        nom_fichier = Dir
    Loop

    'Réactiver les alertes
    Application.DisplayAlerts = True

End Sub

Merci beaucoup c'est déjà super !

La j'essaye de faire en sorte qu'il y a une ligne qui soit sautée entre chaque tableau ; )

Vous pouvez simplement modifier la partie de la boucle qui colle les données pour déplacer le collage vers la ligne suivante. Vous pouvez le faire en ajoutant 2 au lieu de 1 à l'Offset dans le code. Le code modifie :

Option Explicit

Public Sub ouvrir_tous_les_fichiers()

    'Enleve les fenetres de demande
    Application.DisplayAlerts = False

    'Declaration des variables
    Dim nom_fichier As String
    Dim fichier_synthese As String
    Dim dossier As String
    Dim wb As Workbook

    fichier_synthese = "Synthèse"
    dossier = "d:\Lcasado\Desktop\TEST\"

    'Boucle sur tous les fichiers dans le dossier
    nom_fichier = Dir(dossier & "*.xlsx")
    Do While nom_fichier <> ""
        'Ouverture du fichier
        Set wb = Workbooks.Open(dossier & nom_fichier)

        'Activation de la feuille 2
        wb.Sheets("Evaluations").Activate

        'Sélection des cellules A2 à F18 et copie
        Range("A2:F18").Copy

        'Coller dans le fichier synthese
        With Workbooks(fichier_synthese).Sheets("Synthèse")
            .Cells(.Rows.Count, "A").End(xlUp).Offset(2, 0).PasteSpecial xlPasteAll
        End With

        'Fermeture du fichier ouvert
        wb.Close SaveChanges:=False

        'Obtenir le nom du prochain fichier
        nom_fichier = Dir
    Loop

    'Réactiver les alertes
    Application.DisplayAlerts = True

End Sub

Effectivement je n'avais pas vu merci beaucoup !

Pas de souci ^^