Boucle Tant que

En fait elle ne fonctionnait pas correctement donc j'ai voulu l'aligner sur le modèle des autres extractions qui fonctionnaient parfaitement ^^

Mais si tu le dis ! En fait, ma commande demande à extraire des données se trouvant dans la feuille "Bilan" mais ma macro les prends dans la première feuille donc je trouve ça étrange !

Et au lieu de décaler la colonne d'arrivée d'une case à droite à chaque fois eh bien il décale la colonne source d'une case à droite à chaque fois donc je cherche le problème ! Et vouloir "simplifier" n'a pas aidé

Salut Bruno !

Je voulais te tenir au courant du travail. La macro fonctionne bien et j'ai pu rajouter de la mise en forme. Ta méthode pour le copier/coller n'a pas fonctionné alors nous avons opté pour une méthode un peu plus complexe mais qui a le mérite de bien fonctionner ! Je pose la macro finale pour que ça serve aux prochains.

Désormais, je vais mettre en place une barre de progression. Il peut y avoir beaucoup de fichier, ça permettra de savoir où on en est, mais c'est un autre défi !

Merci encore

Private Sub Workbook_Open()

    'Partie 1 : Creation du fichier bilan

    Dim CheminClasseurBilan As String, NomClasseurBilan As String, ClasseurBilan As Workbook
    'Destination du fichier a creer
    CheminClasseurBilan = ActiveWorkbook.Path & "\Fichiers-générés\"
    'Nom du fichier a creer
    NomClasseurBilan = "Bilan-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Time, "hh-mm-ss") & ".xlsx"
    'Creation du fichier
    Set ClasseurBilan = Application.Workbooks.Add
    'Enregistrement du fichier avec le nom et la destination enregistres
    ClasseurBilan.SaveAs CheminClasseurBilan & NomClasseurBilan

    'Partie 2 : Remplissage initiale du fichier bilan

    'Nom de la premiere feuille
    ClasseurBilan.Sheets(1).Name = "Résultats"
    'Remplissage des cinq premieres cellules (valeurs fixes)
    ClasseurBilan.Sheets(1).Range("A1") = "Nom du fichier"
    ClasseurBilan.Sheets(1).Range("A2") = "Centre"
    ClasseurBilan.Sheets(1).Range("A3") = "Date"
    ClasseurBilan.Sheets(1).Range("A4") = "Nom"
    ClasseurBilan.Sheets(1).Range("A5") = "Nom"

    'Partie 3 : Synthese des fichiers sources vers le fichier bilan

    Dim CheminClasseurAudit As String, NomClasseurAudit As String, ClasseurAudit As Workbook, NumeroColonne As Integer
    Dim NumeroLigneBilan As Integer, NumeroLigneAudit As Integer
    '\Fichiers-à-traiter\ est le dossier des classeurs à traiter
    'Emplacement des fichiers d'audits
    CheminClasseurAudit = ThisWorkbook.Path & "\Fichiers-à-traiter\"
    NomClasseurAudit = Dir(CheminClasseurAudit & "*.xlsx")
    'Numéro initial de la 1ère colonne
    NumeroColonne = 2

    'Traitement des classeurs

    Do While NomClasseurAudit <> ""

        'Ouvrir le classeur audit
        Set ClasseurAudit = Workbooks.Open(CheminClasseurAudit & NomClasseurAudit)
        'Insertion nom du classeur
        ClasseurBilan.Sheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
        'Insertion nom du centre
        ClasseurBilan.Sheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Sheets(1).Cells(3, NumeroColonne).NumberFormat = "m/d/yyyy"
        ClasseurBilan.Sheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Sheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B3")
        ClasseurBilan.Sheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B4")

        'Initialisiation de la premiere cellule a extraire
        NumeroLigneBilan = 7
        NumeroLigneAudit = 13

        'Synthese des resultats
        While NumeroLigneBilan < 28

            'Extraction de la donnee concernee
            ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, NumeroColonne) = ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 3)
            'Extraction des titres
            ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, 1) = ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2)
            'Donnee suivante
            NumeroLigneBilan = NumeroLigneBilan + 1
            NumeroLigneAudit = NumeroLigneAudit + 1

        Wend

        'Fermer le classeur d'audit ouvert
        ClasseurAudit.Close SaveChanges:=False

        'Colonne suivante
        NumeroColonne = NumeroColonne + 1
        'Classeur suivant
        NomClasseurAudit = Dir

    Loop

    'Partie 4 : Mise en page et arret de la macro

    'Adaptation de la longueur des cellules a leur contenu
    ClasseurBilan.Sheets(1).Columns("A:XFD").AutoFit
    'Decalage des donnees vers la gauche pour les cellules contenant les dates
    ClasseurBilan.Sheets(1).Range("B3:XFD3").HorizontalAlignment = xlLeft
    'Decalage des donnees vers la droite pour les cellules contenant les statistiques
    ClasseurBilan.Sheets(1).Range("B7:XFD1048576").HorizontalAlignment = xlRight
    'Conversion des nombres en pourcentage
    ClasseurBilan.Sheets(1).Range("B7:XFD1048576").Style = "Percent"
    'Sauvegarde
    ClasseurBilan.Save
    'Fermeture du classeur
    ClasseurBilan.Close

End Sub

Le code final, ça pourra servir pour ceux qui se posaient les mêmes questions.

Private Sub Workbook_Open()

    'Partie 1 : Creation du fichier bilan

    Dim CheminClasseurBilan As String, NomClasseurBilan As String
    Dim ClasseurBilan As Workbook
    'Destination du fichier a creer
    CheminClasseurBilan = ActiveWorkbook.Path & "\Fichiers-générés\"
    'Nom du fichier a creer
    NomClasseurBilan = "Bilan-" & Format(Date, "yyyy-mm-dd") & _
            "-" & Format(Time, "hh-mm-ss") & ".xlsx"
    'Creation du fichier
    Set ClasseurBilan = Application.Workbooks.Add
    'Enregistrement du fichier avec le nom et la destination enregistres
    ClasseurBilan.SaveAs CheminClasseurBilan & NomClasseurBilan

    'Partie 2 : Remplissage initiale du fichier bilan

    'Nom de la premiere feuille
    ClasseurBilan.Sheets(1).Name = "Résultats"
    'Remplissage des cinq premieres cellules (valeurs fixes)
    ClasseurBilan.Sheets(1).Range("A1") = "Nom du fichier"
    ClasseurBilan.Sheets(1).Range("A2") = "Centre"
    ClasseurBilan.Sheets(1).Range("A3") = "Date"
    ClasseurBilan.Sheets(1).Range("A4") = "Nom"
    ClasseurBilan.Sheets(1).Range("A5") = "Nom"

    'Partie 3 : Synthese des fichiers sources vers le fichier bilan

    Dim CheminClasseurAudit As String, NomClasseurAudit As String
    Dim ClasseurAudit As Workbook, NumeroColonne As Integer
    Dim NumeroLigneBilan As Integer, NumeroLigneAudit As Integer
    '\Fichiers-à-traiter\ est le dossier des classeurs a traiter
    'Emplacement des fichiers d'audits
    CheminClasseurAudit = ThisWorkbook.Path & "\Fichiers-à-traiter\"
    NomClasseurAudit = Dir(CheminClasseurAudit & "*.xls")
    'Numéro initial de la 1ère colonne
    NumeroColonne = 2

    'Traitement des classeurs

    Do While NomClasseurAudit <> ""

        'Ouvrir le classeur audit
        Set ClasseurAudit = Workbooks.Open(CheminClasseurAudit & NomClasseurAudit)
        'Insertion nom du classeur
        ClasseurBilan.Sheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
        'Insertion nom du centre
        ClasseurBilan.Sheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Sheets(1).Cells(3, NumeroColonne).NumberFormat = "m/d/yyyy"
        ClasseurBilan.Sheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Sheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B3")
        ClasseurBilan.Sheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B4")

        'Initialisiation de la premiere cellule a extraire
        NumeroLigneBilan = 7
        NumeroLigneAudit = 13

        'Synthese des resultats compris entre la première cellule des resultats
        'et celle contenant le mot "Moyenne"
        While ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2) <> "Moyenne"

            'Extraction de la donnee concernee
            ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, NumeroColonne) = _
                    ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 3)
            'Extraction des titres systematique
            'au cas ou les classeurs n'ont pas tous les memes titres
            ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, 1) = _
                    ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2)
            'Donnee suivante
            NumeroLigneBilan = NumeroLigneBilan + 1
            NumeroLigneAudit = NumeroLigneAudit + 1

        Wend

        'Fermer le classeur d'audit ouvert
        ClasseurAudit.Close SaveChanges:=False

        'Colonne suivante
        NumeroColonne = NumeroColonne + 1
        'Classeur suivant
        NomClasseurAudit = Dir

    Loop

    'Partie 4 : Mise en page et arret de la macro

    'Adaptation de la longueur des cellules a leur contenu
    ClasseurBilan.Sheets(1).Columns("A:XFD").AutoFit
    'Centrage de toutes les donnees
    ClasseurBilan.Sheets(1).Columns("A:XFD").HorizontalAlignment = xlCenter
    'Conversion des nombres en pourcentage
    ClasseurBilan.Sheets(1).Range("B7:XFD1048576").Style = "Percent"
    'Sauvegarde
    ClasseurBilan.Save
    'Fermeture du classeur
    ClasseurBilan.Close

End Sub