Synthèse VBA plusieurs classeurs AVEC des reports

Bonjour,

Je viens solliciter votre bien aimable aide.
Je dois recueillir le résultats des tests contenus dans plusieurs fichiers excel enregistrés dans le dossier et ayant la même structure.
J'ai un premier fichier "Dépouil Test" ( dans un dossier différent de celui des autres fichiers tests cibles ) dans lequel je veux stocker ma macro qui doit récupérer les données des différents fichiers des testeurs 3, 4 et 5.

Dans la cellule G7 du fichier Dépouil Test, on doit mettre la somme de toutes les cellules G7 des fichiers Test ainsi de suite.
Les fichiers ont la même structure, G8, G8 des fichiers Tests....Gn, Gn des fichiers Test.
J'ai réussi à adapter une macro pour parcourir tous les fichiers excel présents dans mon répertoire et à faire un premier pas dans le recueil des résultats tests. Voir le code mis dans le fichier DépouillTest.

Dans un second temps, je voudrais svp créer un onglet pour chaque testeur dans le fichier dépouillement qui serait la copie conforme de l'onglet "CD" , en gros une copie. Par exemple, créer juste dans le classeur dépouillement, 3 onglets testeur3 ,testeur4.....testn. le nom, des onglets = le dernier mots dans mon fichier excel ou mieux mettre dans l'onglet "List_Resulats" du fichier dépouillement la colonne G de chaque fichier testeur. LE code Sub sommescellule_G9 fonctionne mais je n'arrive pas à mettre en boucle. Du coup, à défaut de trouver une solution, je vais devoir faire près de 80 fois cette marco pour remplir les cellulles G9 à G81.

Merci pour votre aide.Je suis désespéré.

En g6 de la feuille de la macro, j'ai mis "total" car ca me simplifie après.
En g7, j'ai mis la formule -> ="0 : " & NB.SI(H7:Q7;"=0")&" § 1 : " & NB.SI(H7:Q7;"=1")&" § 2 : " & NB.SI(H7:Q7;"=2")&" § 3 : " & NB.SI(H7:Q7;"=3")
Il vous suffit de faire une somme pour votre demande, mais il me semble que la répartition serait peut être plus utile. Tirez la formule jusqu'en G81.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36

Sub sommescellule_G9() Dim objShell As Object, objFolder As Object Dim Chemin As String, fichier As String Dim wb As Workbook Dim ws As Worksheet Dim result As Worksheet Set result = Sheets("List_Resulats")   Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)   If objFolder Is Nothing Then MsgBox "Arret de la macro", vbCritical, "Annulation" Else 'Sélection du répertoire Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\" result.Range("H6:Q81").Value = "" 'format du fichier (par exemple xlsx) fichier = Dir(Chemin & "*.xlsx") Do While Len(fichier) > 0 If fichier <> ThisWorkbook.Name Then Set wb = Workbooks.Open(Chemin & fichier) Set ws = wb.Sheets("CD") result.Range("C6").End(xlToRight).Offset(0, 1).Value = Replace(Replace(fichier, ".xlsx", ""), "Cahier recettes ", "") result.Range("C6").End(xlToRight).Offset(1, 0).Resize(75, 1).Value = ws.Range("G7:G81").Value Set ws = Nothing wb.Saved = True wb.Close Set wb = Nothing End If fichier = Dir() Loop End If     End Sub

---

ajoutez des tests pour vérifier qu'il y a bien un onglet cd mais cela vous fait un départ déjà.
Vous n'avez pas besoin du If fichier <> ThisWorkbook.Name Then car la macro est xlsm et que vous parcourez des xlsx

vous pouvez aussi remplacer result.Range("C6").End(xlToRight).Offset(1, 0).Resize(75, 1).Value = ws.Range("G7:G81").Value par une copie de l'onglet cd dans votre classeur de macro, renommer l'onglet Replace(Replace(fichier, ".xlsx", ""), "Cahier recettes ", "") et faire dans la colonne en dessous des liens vers la colonne g de l'onglet.