Boucle Tant que

Le 18/11/2017 à 19:23

Bonjour à tous,

Je souhaiterais vos conseils avisés pour mettre en place une boucle tant que dans une macro VBA.

Je m'explique, je dispose de plusieurs classeurs excel, tous ont la même trame, seuls les valeurs changent et je souhaite traiter TOUS les classeurs xls situés dans un dossier précis en extrayant à chaque fois les données qui m'intéressent de chaque classeur (toujours les mêmes).

Problème : La macro ne fonctionne pas et beug à la boucle Tant que.

Il indique : "For each ne peut être itéré que sur un objet collection ou un tableau "

Quelques idées à me suggérer ?

Je vous mets la macro complète, seule la partie 3 m'intéresse, et elle n'est pas encore terminée.

Merci beaucoup

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.Worksheets(1).Name = "Résultats"
    'Remplissage des cinq premieres cellules (valeurs fixes)
    ClasseurBilan.Worksheets(1).Range("A1") = "Nom du fichier"
    ClasseurBilan.Worksheets(1).Range("A2") = "Centre"
    ClasseurBilan.Worksheets(1).Range("A3") = "Date"
    ClasseurBilan.Worksheets(1).Range("A4") = "Nom"
    ClasseurBilan.Worksheets(1).Range("A5") = "Nom"

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

    Dim CheminClasseursAudits As String, ClasseurAudit As Workbook, NumeroColonne As Integer
    'Emplacement des fichiers d'audits
    CheminClasseursAudits = ActiveWorkbook.Path & "\Fichiers-à-traiter\"
    'Selectionner des fichiers Excel uniquement
    ClasseurAudit = Dir("*.xlsx")
    'Compteur de colonne
    NumeroColonne = 2
    'Traitement des classeurs

    For Each ClasseurAudit In CheminClasseursAudits

        'Insertion du centre
        ClasseurBilan.Name = ClasseurAudits.Worksheets(1).Range("NumeroColonne,1")
        ClasseurBilan.Worksheets(1).Range("D3") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,2")
        'Insertion de la date
        ClasseurBilan.Worksheets(1).Range("D4") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,3")
        'Insertion des noms
        ClasseurBilan.Worksheets(1).Range("B3") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,4")
        ClasseurBilan.Worksheets(1).Range("B4") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,5")
        'Incrementation du compteur de colonne

        ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,7").Select
        ClasseurBilan.Worksheets(1).Range("C13:C33").Paste

        NumeroColonne = NumeroColonne + 1

    'Partie 4 : Arret de la macro

    'Sauvegarde
    ClasseurBilan.Save
    'Fermeture du fichier
    ClasseurBilan.Close

End Sub
Le 18/11/2017 à 19:43

Bonsoir Haonam,

Perso je ne mettrais pas cette procédure à l'ouverture du classeur, trop dangereux

Mais sinon, essaye ce code

Sub MiseAJourBilan()
  '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.Worksheets(1).Name = "Résultats"
  'Remplissage des cinq premieres cellules (valeurs fixes)
  ClasseurBilan.Worksheets(1).Range("A1") = "Nom du fichier"
  ClasseurBilan.Worksheets(1).Range("A2") = "Centre"
  ClasseurBilan.Worksheets(1).Range("A3") = "Date"
  ClasseurBilan.Worksheets(1).Range("A4") = "Nom"
  ClasseurBilan.Worksheets(1).Range("A5") = "Nom"

  'Partie 3 : Synthese des fichiers sources vers le fichier bilan
  Dim CheminNomClasseurAudit As String, ClasseurAudit As Workbook, NumeroColonne As Integer
  'Emplacement et nom des fichiers d'audits
  CheminNomClasseurAudit = Dir(ActiveWorkbook.Path & "\Fichiers-à-traiter\*.xlsx")
  'Compteur de colonne
  NumeroColonne = 2
  'Traitement des classeurs

  Do While CheminNomClasseurAudit <> ""
    ' Ouvrir le classeur audit
    Set ClasseurAudit = Workbooks.Open(CheminNomClasseurAudit)
    'Insertion du centre - PAS BIEN COMPRIS CECI !?
    ' J'ai donc changé pour ce qui me paraissait le plus logique
    ClasseurBilan.Names.Add ClasseurAudit.Worksheets(1).Range("NumeroColonne,1")
    '
    ClasseurBilan.Worksheets(1).Range("D3") = ClasseurAudit.Worksheets(1).Range("NumeroColonne,2")
    'Insertion de la date
    ClasseurBilan.Worksheets(1).Range("D4") = ClasseurAudit.Worksheets(1).Range("NumeroColonne,3")
    'Insertion des noms
    ClasseurBilan.Worksheets(1).Range("B3") = ClasseurAudit.Worksheets(1).Range("NumeroColonne,4")
    ClasseurBilan.Worksheets(1).Range("B4") = ClasseurAudit.Worksheets(1).Range("NumeroColonne,5")
    'Incrementation du compteur de colonne

    ClasseurAudit.Worksheets("Bilan").Range("C13:C33").Copy
    ClasseurBilan.Worksheets(1).Range("NumeroColonne,7").Select
    ClasseurBilan.Worksheets(1).Range("C13:C33").Paste
    ' Fermer le classeur audit ouvert
    ClasseurAudit.Close SaveChanges:=False
    ' Colonne suivant
    NumeroColonne = NumeroColonne + 1
    ' Classeur suivant
    CheminNomClasseurAudit = Dir
  Loop
  'Partie 4 : Arret de la macro
  'Sauvegarde
  ClasseurBilan.Save
  'Fermeture du fichier
  ClasseurBilan.Close
End Sub

A+

Le 18/11/2017 à 20:05

Je ne sais pas ce qui m'impressionne le plus, la rapidité ou la qualité de ta réponse !

Merci beaucoup pour ton aide précieuse.

Alors en réponse à tes remarques :

  • L’exécution de la macro à l'ouverture du fichier est une demande du client pour qu'il ait le moins de travail possible
  • Le "centre" en fait c'est le nom de l'entreprise. Tu auras compris que le but de la macro est de synthétiser les résultats d'audits réalisés dans différents "centres". Du coup, dans chaque colonne, je mets le nom du classeur ainsi que le nom de l'entreprise (le centre), des auditeurs et ensuite les résultats. Ensuite colonne suivante, et on recommence pour un autre audit, etc.

Je teste la macro et je reviens vers toi !

Le 18/11/2017 à 20:22

Grâce à toi j'ai vu que j'avais une confusion entre mes classeurs, donc merci.

Alors je n'ai aucun bug d'exécution, ce qui est une très bonne chose déjà ^^

Malheureusement le classeur crée est vide. Enfin il comporte les données de base (le bon titre, le bon nom d'onglet et les bonnes premières cellules) par contre les données du la boucle While ne sont nul par, le vide !

Une idée ?

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.Worksheets(1).Name = "Résultats"
    'Remplissage des cinq premieres cellules (valeurs fixes)
    ClasseurBilan.Worksheets(1).Range("A1") = "Nom du fichier"
    ClasseurBilan.Worksheets(1).Range("A2") = "Centre"
    ClasseurBilan.Worksheets(1).Range("A3") = "Date"
    ClasseurBilan.Worksheets(1).Range("A4") = "Nom"
    ClasseurBilan.Worksheets(1).Range("A5") = "Nom"

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

    Dim CheminNomClasseurAudit As String, ClasseurAudits As Workbook, NumeroColonne As Integer
    'Emplacement des fichiers d'audits
    CheminNomClasseurAudit = Dir(ActiveWorkbook.Path & "\Fichiers-à-traiter\*.xlsx")
    'Compteur de colonne
    NumeroColonne = 2
    'Traitement des classeurs

    Do While CheminNomClasseurAudit <> ""

        'Ouvrir le classeur audit
        Set ClasseurAudits = Workbooks.Open(CheminNomClasseurAudit)
        'Insertion nom du classeur
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,1") = ClasseurAudits.Name
        'Insertion nom du centre
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,2") = ClasseurAudits.Worksheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,3") = ClasseurAudits.Worksheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,4") = ClasseurAudits.Worksheets(1).Range("B3")
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,5") = ClasseurAudits.Worksheets(1).Range("B4")

        'Synthese des resultats
        ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,7").Select
        ClasseurBilan.Worksheets(1).Range("C13:C33").Paste

        'Fermer le classeur audit ouvert
        ClasseurAudits.Close SaveChanges:=False
        'Colonne suivante
        NumeroColonne = NumeroColonne + 1
        'Classeur suivant
        CheminNomClasseurAudit = Dir

    Loop

    'Partie 4 : Arret de la macro

    'Sauvegarde
    ClasseurBilan.Save
    'Fermeture du fichier
    ClasseurBilan.Close

End Sub

Je crois que le problème est ici en fait :

ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy
ClasseurBilan.Worksheets(1).Range("NumeroColonne,7").Select
ClasseurBilan.Worksheets(1).Range("C13:C33").Paste

Les données à récupérer sont dans le classeur audit aux cellules C13 à C33 mais doivent être collés dans les cellules B7 à B27 du classeur Bilan, puis C7 à C27, puis D, etc.

Le 18/11/2017 à 20:50

RE

haonam a écrit :

Grâce à toi j'ai vu que j'avais une confusion entre mes classeurs, donc merci.

Mais, de rien

haonam a écrit :
ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy
ClasseurBilan.Worksheets(1).Range("NumeroColonne,7").Select
ClasseurBilan.Worksheets(1).Range("C13:C33").Paste

Les données à récupérer sont dans le classeur audit aux cellules C13 à C33 mais doivent être collés dans les cellules B7 à B27 du classeur Bilan, puis C7 à C27, puis D, etc.

Tu vois quand tu veux

Je ne voyais pas à quoi servait ton "NumeroColonne" entre guillemets

Les trois lignes sont à remplacer par

       ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy _
        Destination:=ClasseurBilan.Worksheets(1).Cells(7, NumeroColonne)

A plus

Le 18/11/2017 à 21:00

J'essaye d'être clair mais ce n'est pas toujours évident ^^

Je crois que c'est plutôt :

ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy _
Destination:=ClasseurBilan.Worksheets(1).Cells(NumeroColonne, 7)

En fait la ligne est constance mais je décale d'une colonne à droite à chaque fois. Du coup j'ai remplacé (7, NumeroColonne) par (NumeroColonne, 7) !!

Sinon toujours pas d'erreur d'exécution (oui j'aime le répéter mais c'est toujours une bonne nouvelle). Par contre le classeur crée reste vide. Toute cette partie là ne s'exécute pas en fait :

Do While CheminNomClasseurAudit <> ""

        'Ouvrir le classeur audit
        Set ClasseurAudits = Workbooks.Open(CheminNomClasseurAudit)
        'Insertion nom du classeur
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,1") = ClasseurAudits.Name
        'Insertion nom du centre
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,2") = ClasseurAudits.Worksheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,3") = ClasseurAudits.Worksheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,4") = ClasseurAudits.Worksheets(1).Range("B3")
        ClasseurBilan.Worksheets(1).Range("NumeroColonne,5") = ClasseurAudits.Worksheets(1).Range("B4")

        'Synthese des resultats
        ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy _
        Destination:=ClasseurBilan.Worksheets(1).Cells(NumeroColonne, 7)

        'Fermer le classeur audit ouvert
        ClasseurAudits.Close SaveChanges:=False
        'Colonne suivante
        NumeroColonne = NumeroColonne + 1
        'Classeur suivant
        CheminNomClasseurAudit = Dir

    Loop

Le reste marche parfaitement ^^

Le 18/11/2017 à 21:20

Re,

Quand on fait appel à la propriété Cells()

La première valeur est la ligne, la 2eme la colonne

Maintenant c'est comme tu veux

Le 18/11/2017 à 21:25

Ok je m'incline, je retiens et je modifie ça ^^

juste à faire fonctionner la partie qui ne s'exécute pas maintenant !

Les dossiers sont à leur place et les noms cohérents pourtant.

Tu as une idée de ce qui peut faire défaut ?

J'ai du mal à voir mais c'est une étoile ici ?

 CheminNomClasseurAudit = Dir(ActiveWorkbook.Path & "\Fichiers-à-traiter\*.xlsx")
Le 18/11/2017 à 21:40

Re,

Oui c'est pour trouver le nom complet du fichier avec l'extension

Le 18/11/2017 à 21:43

ok merci

Une chose m'intrigue aussi, on est d'accord que "Fichiers-à-traiter" est le nom d'un dossier et non d'un classeur ! C'est un sous dossier qui se trouve dans la dossier actuel. Il s'agit de trouver tous les classeurs qui sont dans le dossier "Fichiers-à-traiter" et qui ont une extension xlsx.

C'est bien ce que la macro fait ?

Le 18/11/2017 à 22:06

Re,

Oui c bien ça

Le 18/11/2017 à 22:14

ok merci

Bon je trouve pas pourquoi la macro ne s'exécute pas alors je vais dormir et je recommencerai demain !

Merci bien

Le 19/11/2017 à 08:16

Bonjour,

J'espère que tu as bien dormi

2 choses :

1) tu t'évertues à garder l'instruction "Range("NumeroColonne,1")" qui ne fonctionne pas

2) Tu n'utilise pas la bonne variable, il faut supprimer le "s" à la fin de "ClasseurAudits"

On utilise en général un classeur d'audit et non un classeur des audits... enfin je pense

Voici ton code rectifié et amélioré avec un petite question de départ 

Private Sub Workbook_Open()

  If MsgBox("Voulez-vous lancer la mise à jours des bilans ?", _
            vbQuestion + vbYesNo, "MISE à JOUR ...") = vbNo Then Exit Sub

  '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.Worksheets(1).Name = "Résultats"
  'Remplissage des cinq premieres cellules (valeurs fixes)
  ClasseurBilan.Worksheets(1).Range("A1") = "Nom du fichier"
  ClasseurBilan.Worksheets(1).Range("A2") = "Centre"
  ClasseurBilan.Worksheets(1).Range("A3") = "Date"
  ClasseurBilan.Worksheets(1).Range("A4") = "Nom"
  ClasseurBilan.Worksheets(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
  '\Fichiers-à-traiter\ est le dossier des classeurs à traiter
  'Emplacement des fichiers d'audits
  CheminClasseurAudit = ActiveWorkbook.Path & "\Fichiers-à-traiter\"
  NomClasseurAudit = Dir(CehminClasseurAudit & "*.xlsx")
  'Numéro initial de la 1ère colonne
  NumeroColonne = 2

  'Traitement des classeurs

  Do While CheminNomClasseurAudit <> ""
    'Ouvrir le classeur audit
    Set ClasseurAudit = Workbooks.Open(CheminClasseurAudit & NomClasseurAudit)
    'Insertion nom du classeur
    ClasseurBilan.Worksheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
    'Insertion nom du centre
    ClasseurBilan.Worksheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("D3")
    'Insertion de la date
    ClasseurBilan.Worksheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("D4")
    'Insertion des deux noms
    ClasseurBilan.Worksheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("B3")
    ClasseurBilan.Worksheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("B4")

    'Synthese des resultats
    ClasseurAudit.Worksheets("Bilan").Range("C13:C33").Copy _
        Destination:=ClasseurBilan.Worksheets(1).Cells(7, NumeroColonne)

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

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

  Loop

  'Partie 4 : Arret de la macro

  'Sauvegarde
  ClasseurBilan.Save
  'Fermeture du fichier
  ClasseurBilan.Close

End Sub

Edit : code corrigé au niveau du DIR()

A+

Le 19/11/2017 à 09:28

Oh que oui !

Merci pour le msg box, ça ajoute un contrôle.

Je reprends donc le code :

  • Ok tu remplaces la commande "Range" par la commande "Cells" lorsque les cellules désirées ne sont pas fixes
  • Et oui c'est un audit par classeur

Du coup j'ai pris en compte toutes tes remarques ! Le classeur crée correspond bien à toutes les commandes des parties 1, 2 et 4 mais la 3 toujours pas ^^

Pourtant, les classeurs sont tous à leur place, ont tous une extension xlsx, les noms des variables sont corrects et le reste de la macro fonctionne parfaitement.

Private Sub Workbook_Open()

    If MsgBox("Voulez-vous lancer la mise à jours des bilans ?", _
    vbQuestion + vbYesNo, "MISE à JOUR ...") = vbNo Then Exit Sub

    '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.Worksheets(1).Name = "Résultats"
    'Remplissage des cinq premieres cellules (valeurs fixes)
    ClasseurBilan.Worksheets(1).Range("A1") = "Nom du fichier"
    ClasseurBilan.Worksheets(1).Range("A2") = "Centre"
    ClasseurBilan.Worksheets(1).Range("A3") = "Date"
    ClasseurBilan.Worksheets(1).Range("A4") = "Nom"
    ClasseurBilan.Worksheets(1).Range("A5") = "Nom"

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

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

    'Traitement des classeurs

    Do While CheminNomClasseurAudit <> ""

        'Ouvrir le classeur audit
        Set ClasseurAudit = Workbooks.Open(CheminNomClasseurAudit)
        'Insertion nom du classeur
        ClasseurBilan.Worksheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
        'Insertion nom du centre
        ClasseurBilan.Worksheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Worksheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Worksheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("B3")
        ClasseurBilan.Worksheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("B4")

        'Synthese des resultats
        ClasseurAudit.Worksheets("Bilan").Range("C13:C33").Copy _
        Destination:=ClasseurBilan.Worksheets(1).Cells(7, NumeroColonne)

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

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

    Loop

    'Partie 4 : Arret de la macro

    'Sauvegarde
    ClasseurBilan.Save
    'Fermeture du fichier
    ClasseurBilan.Close

End Sub
Le 19/11/2017 à 10:37

Re,

J'ai trouvé, je pense, je me suis fourvoyé avec le DIR()

Ca ne te donne que le nom entier du fichier mais pas le chemin d'accès

Il faut donc pour la partie 3, remplacer le début du code par

 Dim CheminClasseurAudit As String, NomClasseurAudit As String, ClasseurAudit As Workbook, NumeroColonne As Integer
  '\Fichiers-à-traiter\ est le dossier des classeurs à traiter
  'Emplacement des fichiers d'audits
  CheminClasseurAudit = ActiveWorkbook.Path & "\Fichiers-à-traiter\"
  NomClasseurAudit = Dir(CehminClasseurAudit & "*.xlsx")

Ensuite pour ouvrir le classeur

'Ouvrir le classeur audit
    Set ClasseurAudit = Workbooks.Open(CheminClasseurAudit & NomClasseurAudit)

Essaye ça en mettant un point d'arrêt F9 sur la ligne

NomClasseurAudit = Dir(CehminClasseurAudit & "*.xlsx")

Le code va s'arrêter sur cette ligne et pour continuer en vérifiant le contenu de tes variables, tu fais F8

Pour le contenu, tu pointes ton curseur de souris dessus, tout simplement.

A+

Le 19/11/2017 à 11:37

Alors déjà voici la nouvelle macro :

Private Sub Workbook_Open()

    If MsgBox("Voulez-vous lancer la mise à jours des bilans ?", _
    vbQuestion + vbYesNo, "MISE à JOUR ...") = vbNo Then Exit Sub

    '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.Worksheets(1).Name = "Résultats"
    'Remplissage des cinq premieres cellules (valeurs fixes)
    ClasseurBilan.Worksheets(1).Range("A1") = "Nom du fichier"
    ClasseurBilan.Worksheets(1).Range("A2") = "Centre"
    ClasseurBilan.Worksheets(1).Range("A3") = "Date"
    ClasseurBilan.Worksheets(1).Range("A4") = "Nom"
    ClasseurBilan.Worksheets(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
    '\Fichiers-à-traiter\ est le dossier des classeurs à traiter
    'Emplacement des fichiers d'audits
    CheminClasseurAudit = ActiveWorkbook.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.Worksheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
        'Insertion nom du centre
        ClasseurBilan.Worksheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Worksheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Worksheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("B3")
        ClasseurBilan.Worksheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("B4")

        'Synthese des resultats
        ClasseurAudit.Worksheets("Bilan").Range("C13:C33").Copy _
        Destination:=ClasseurBilan.Worksheets(1).Cells(7, NumeroColonne)

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

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

    Loop

    'Partie 4 : Arret de la macro

    'Sauvegarde
    ClasseurBilan.Save
    'Fermeture du fichier
    ClasseurBilan.Close

End Sub

Pas évident de ne pas se tromper entre toutes ces variables ^^

Sinon dans l'exécutionn après la commande "Do while" j'obtiens les résultats suivants :

  • ClasseurAudit = Nothing
  • CheminClasseurAudit = ""
  • NomClasseurAudit = ""
  • ClasseurAudit.Name = Variable objet ou variable de bloc With non définie

Je crois que la macro ne sélectionne pas correctement les fichiers !

Le 19/11/2017 à 12:06

Re,

Dans ton dossier ou se trouve la macro, tu dois avoir le sous dossier nommé "fichiers-à-traiter

Sinon il faut changer le nom

Bon je suis parti avec ma petite femme me faire un bon resto

Le 19/11/2017 à 13:48

Ah j'ai trouvé !

J'ai fait un MsgBox pour voir le nom complet de

CheminClasseurAudit = ActiveWorkbook.Path & "\Fichiers-à-traiter\"

En fait, dans mon dossier j'ai la macro, le sous dossier "fichier générés" et le sous-dossier "fichiers à traiter" !

Au début de la macro, je crée un classeur que je mets dans le sous dossier "fichier générés" !

Du coup, quand je cherche les classeurs sources à la partie 3, la macro se situe encore dans le sous dossier "fichier générés" et non dans le dossier de base.

Donc je dois trouver un moyen pour sortir de ce sous dossier et revenir dans le dossier global où se trouve la macro.

Quasi victoire !!!! Il me suffisait de remplacer "ActiveWorkBook" par "ThisWorkbook" et le problème s'est réglé !

Les valeurs ne sont pas tout à fait les bonnes mais au moins tous les classeurs sont traités et exporter vers le classeur d'arrivé donc merci beaucoup !

La date ne s'affichait pas correctement non plus donc j'ai rajouté une commande. Voici l'état actuel de ma macro :

Private Sub Workbook_Open()

    If MsgBox("Voulez-vous lancer la mise à jours des bilans ?", _
    vbQuestion + vbYesNo, "MISE à JOUR ...") = vbNo Then Exit Sub

    '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.Worksheets(1).Name = "Résultats"
    'Remplissage des cinq premieres cellules (valeurs fixes)
    ClasseurBilan.Worksheets(1).Range("A1") = "Nom du fichier"
    ClasseurBilan.Worksheets(1).Range("A2") = "Centre"
    ClasseurBilan.Worksheets(1).Range("A3") = "Date"
    ClasseurBilan.Worksheets(1).Range("A4") = "Nom"
    ClasseurBilan.Worksheets(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
    '\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.Worksheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
        'Insertion nom du centre
        ClasseurBilan.Worksheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Worksheets(1).Cells(3, NumeroColonne).NumberFormat = "m/d/yyyy"
        ClasseurBilan.Worksheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Worksheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("B3")
        ClasseurBilan.Worksheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Worksheets(1).Range("B4")

        'Synthese des resultats
        ClasseurAudit.Worksheets(4).Range("C13:C33").Copy _
        Destination:=ClasseurBilan.Worksheets(1).Cells(7, NumeroColonne)

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

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

    Loop

    'Partie 4 : Arret de la macro

    'Sauvegarde
    ClasseurBilan.Save
    'Fermeture du fichier
    ClasseurBilan.Close

End Sub
Le 19/11/2017 à 20:21

J'y suis presque !

Je voudrais une info pour l'extraction des données. J'ai simplifié cette formule :

'Synthese des resultats
       ClasseurAudit.Worksheets("Bilan").Range("C13:C33").Copy _
        Destination:=ClasseurBilan.Worksheets(1).Cells(7, NumeroColonne)

en la remplaçant par celle-là :

'Synthese des resultats
ClasseurBilan.Worksheets(1).Cells(7, NumeroColonne) = ClasseurAudit.Worksheets("Bilan").Range("C13:C23")

Bien sûr elle ne fonctionne pas ! DOis-je sélectionner une place de cellule d'arrivée ou est-elle cohérente ?

Merci (PS : Je n'ai pas d'erreur d'exécution mais ça ne fonctionne pas c'est tout ^^)

Le 19/11/2017 à 20:35

Re,

Pourquoi vouloir "simplifier" alors que l'instruction est basic

Dans une cellule tu ne peux pas mettre une plage

Rechercher des sujets similaires à "boucle tant que"