XL 2019 Consolidation Excel - VBA

[OuiOuiNonNon]

Bonjour, j'ai actuellement le code ci-dessous, qui me permet de consolider plusieurs classeurs. J'aimerais rajouter une option mais je ne sais pas comment le faire.
Par exemple, si en B3 la somme de mes classeurs fait 8, alors il y aura 8 d'indiqué sur la cellule B3 du classeur final, mais moi ce que j'aimerais dans cette cellule B3, c'est avoir le détail, d'une manière ou d'une autre, pour que je puisse savoir de quelles classeurs viennent les 8.
Par exemple, 8 dont 3 du classeur1 et 5 du classeur2 (peut importe la forme, juste qu'il faudrait que je le sache d'une manière ou d'une autre pour ne pas devoir regarder dans chaque classeur à chaque fois)
Merci d'avance

Sub Macro3()
Dim chemin$, fichier$, nomfeuil$, nfich%, f$, wb As Workbook
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
nomfeuil = "Feuil1" 'nom à adapter
'---formule concaténée---
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        nfich = nfich + 1
        f = f & IIf(f = "", "='", "+'") & chemin & "[" & fichier & "]" & nomfeuil & "'!A3"
    End If
    fichier = Dir 'fichier suivant
Wend
'--remplissage du tableau---
With [A3:K23]
    .Formula = f
End With
MsgBox nfich & " Fichiers consolidés "
End Sub

 

[Robert]

Bonjour ONON, bonjour le forum,

Une proposition avec un commentaire :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim T As Double 'déclare la variable T (Total)
Dim C As String 'déclare la variable C (Commentaire)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
CA = ThisWorkbook.Path & "\" 'définit le chemin d'accès CA (à adapter)
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination (à adapter)
F = Dir(CA & "*.xls*") '1er fichier du dossier
Do While F <> "" 'exécute tant qu'il existe des fichiers
    If F <> CD.Name Then 'condition : si le fichier n'est pas le classeur destination CD
        Set CS = Workbooks.Open(CA & F) 'définit le classeur source en l'ouvrant
        Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source
        T = T + OS.Range("A3").Value 'définit le total T
        C = IIf(C = "", F & " : " & Range("A3").Value, C & Chr(10) & F & " : " & Range("A3").Value) 'définit le commentaire C
        CS.Close False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
    F = Dir 'fichier suivant
Loop 'boucle
With OD.Range("B3") 'prend en compte la cellule B3 de l'onglet destination OD
    .Value = T 'renvoir le total T
    On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
    .Comment.Delete 'supprime un éventuel commentaire existant (génère une erreur si pas de commentaire)
    .AddComment C 'ajoute C en commentaire
    .Comment.Shape.Height = 50 'hauteur du commentaire (à adapter ou supprimer)
    .Comment.Shape.Width = 250 'largeur du commentaire (à adapter ou supprimer)
    .Comment.Visible = False 'masque le commentaire
End With 'fin de la prise en compte de la cellule B3 de l'onglet OD
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox nfich & " Fichiers consolidés " 'message
End Sub

 

[OuiOuiNonNon]

Merci beaucoup c'est ce qu'il me faut ! Est ce qu'il serait possible de le faire pas juste pour la cellule B3 mais pour toute une plage de cellule comme B3:G20, avec sur chaque cellule, son commentaire, comme tu as fait avec la cellule B3 ?

 

[Robert]

Re,

Ça donnerait ça :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim F As String 'déclare la variable F (Fichier)
Dim CT As Integer 'décare la variable C (Compteur)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim T(1 To 18, 1 To 6) As Double 'déclare le tableau de variables T (Total)
Dim C(1 To 18, 1 To 16) As String 'déclare le tableau de variables C (Commentaire)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable F (incrément)
Dim PL As Range 'déclare la variable PL (PLage)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
CA = ThisWorkbook.Path & "\" 'définit le chemin d'accès CA (à adapter)
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination (à adapter)
F = Dir(CA & "*.xls*") '1er fichier du dossier
Do While F <> "" 'exécute tant qu'il existe des fichiers
    If F <> CD.Name Then 'condition : si le fichier n'est pas le classeur destination CD
        CT = CT + 1
        Set CS = Workbooks.Open(CA & F) 'définit le classeur source en l'ouvrant
        Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source
        TV = OS.Range("B3:G20")
        For I = 1 To UBound(TV, 1)
            For J = 1 To UBound(TV, 2)
                T(I, J) = T(I, J) + TV(I, J) 'définit le total indexé T
                C(I, J) = IIf(C(I, J) = "", F & " : " & TV(I, J), C(I, J) & Chr(10) & F & " : " & TV(I, J)) 'définit le commentaire indexé C
            Next J
        Next I
        CS.Close False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
    F = Dir 'fichier suivant
Loop 'boucle
Set PL = OD.Range("B3:G20") 'définit la plage B3:G20 de l'onglet destination OD
For I = 1 To PL.Rows.Count 'boucle 1 : sur toutes les lignes I de la plage PL
    For J = 1 To PL.Columns.Count 'boucle 2 : sur toutes les Colonnes J de la plage PL
        With PL.Cells(I, J) 'prend en compte la cellule ligne I colonne J de la plage PL de l'onglet OD
            .Value = T(I, J) 'renvoie le total indexé T(I,J)
            On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
            .Comment.Delete 'supprime un éventuel commentaire existant (génère une erreur si pas de commentaire)
            .AddComment C(I, J) 'ajoute le commentaire indexé C(I,J)
            .Comment.Shape.Height = 50 'hauteur du commentaire (à adapter ou supprimer)
            .Comment.Shape.Width = 250 'largeur du commentaire (à adapter ou supprimer)
            .Comment.Visible = False 'masque le commentaire
        End With 'fin de la prise en compte de la cellule ligne I colonne J de la plage PL de l'onglet OD
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox CT & " Fichiers consolidés " 'message
End Sub

 

[OuiOuiNonNon]

Merci Robert, ça fonctionne (et merci aussi pour les explications, ça m'aide à comprendre car je débute encore sur VBA).
Dernière "requête", est ce qu'il serait possible, dans le commentaire, de n'afficher que les classeurs qui contiennent un nombre, je ne sais pas du tout si c'est possible. Le problème est que j'ai beaucoup de classeurs à gérer mais les données sont très éparpillées. Par exemple, pour la cellule B3, j'ai dans le commentaire, une cinquantaine de noms de classeurs, mais seulement deux ont effectivement un nombre dans la cellule B3. Ce qui rend le commentaire très lourd, alors qu'il pourrait être beaucoup plus léger.

 

[Robert]

Re,

je me demande à quoi ça sert que je commente ?!... Une simple condition fait l'affaire
Remplace la ligne :

C(I, J) = IIf(C(I, J) = "", F & " : " & TV(I, J), C(I, J) & Chr(10) & F & " : " & TV(I, J)) 'définit le commentaire indexé C si la donnée ligen I colonne J de TV n'est pas vide

If TV(I, J) <> "" Then C(I, J) = IIf(C(I, J) = "", F & " : " & TV(I, J), C(I, J) & Chr(10) & F & " : " & TV(I, J)) 'définit le commentaire indexé C si la donnée ligne I colonne J de TV n'est pas vide

par :