Synthèse VBA plusieurs classeurs Se trouvant dans le meme do
Bonjour,
Je viens solliciter votre ben 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 excels 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.
Je vous serais très reconnaissant .
Merci Beaucoup pour voir aide
Bonjour,
Sub sommescellule_E6()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim compteur As String
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
'On renseigne le compteur à 0
compteur = 0
'Sélection du répertoire
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'format du fichier (par exemple xlsx)
fichier = Dir(Chemin & "*.xlsx")
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
'la cellule qui va être recherchée dans les autres classeurs est A1 de la feuille 1
'J'ai un peu avancé mais je n'arrive pas à mettre une variable dans ma référence de G10, pour incrémenter en G11 à Gn. avez vous une idée , Merci[/b]
ThisWorkbook.Names.Add "Plage", _
RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$G$10"
'on va coller le résultat dans la feuille 2
With Sheets("List_Resulats")
.[G10] = "=Plage"
'on ajoute le résultat trouvé dans le compteur
compteur = compteur + .[G10].Value
End With
End If
fichier = Dir()
Loop
End If
'On colle le compteur dans la cellule E6
Range("E6").Select
ActiveCell.Value = compteur
Bonjour,
J'ai un petit peu augmenté. Voir Ligne en gras sur laquelle je sèche. Merci Beaucoup
Je Vous soumets les codes. Je n'arrive pas à faire une boucle. donc j'ai plusieurs macros, ce qui n'est pas commode. De plus, je n'arrive pas à mettre par défaut le répertoire. Auriez vous une idée ? merci
Sub all()
Call sommescellule_E4
Call sommescellule_E5
Call sommescellule_E6
Call sommescellule_E7
Call sommescellule_E8
Call sommescellule_E9
Call sommescellule_E10
Call sommescellule_E11
Call sommescellule_E12
Call sommescellule_E13
Call sommescellule_E81
End Sub
Sub sommescellule_E4()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim compteur As String
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
'On renseigne le compteur à 0
compteur = 0
'Sélection du répertoire
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'format du fichier (par exemple xlsx)
fichier = Dir(Chemin & "*.xlsx")
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
'la cellule qui va être recherchée dans les autres classeurs est A1 de la feuille 1
ThisWorkbook.Names.Add "Plage", _
RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$G$8"
'on va coller le résultat dans la feuille 2
With Sheets("List_Resulats")
.[G8] = "=Plage"
'on ajoute le résultat trouvé dans le compteur
compteur = compteur + .[G8].Value
End With
End If
fichier = Dir()
Loop
End If
'On colle le compteur dans la cellule B2
Range("E4").Select
ActiveCell.Value = compteur
End Sub
Sub sommescellule_E5()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim compteur As String
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
'On renseigne le compteur à 0
compteur = 0
'Sélection du répertoire
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'format du fichier (par exemple xlsx)
fichier = Dir(Chemin & "*.xlsx")
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
'la cellule qui va être recherchée dans les autres classeurs est A1 de la feuille 1
ThisWorkbook.Names.Add "Plage", _
RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$G$9"
'on va coller le résultat dans la feuille 2
With Sheets("List_Resulats")
.[G9] = "=Plage"
'on ajoute le résultat trouvé dans le compteur
compteur = compteur + .[G9].Value
End With
End If
fichier = Dir()
Loop
End If
'On colle le compteur dans la cellule E5
Range("E5").Select
ActiveCell.Value = compteur
End Sub
Sub sommescellule_E6()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim compteur As String
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
'On renseigne le compteur à 0
compteur = 0
'Sélection du répertoire
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'format du fichier (par exemple xlsx)
fichier = Dir(Chemin & "*.xlsx")
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
'la cellule qui va être recherchée dans les autres classeurs est A1 de la feuille 1
ThisWorkbook.Names.Add "Plage", _
RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$G$10"
'on va coller le résultat dans la feuille 2
With Sheets("List_Resulats")
.[G10] = "=Plage"
'on ajoute le résultat trouvé dans le compteur
compteur = compteur + .[G10].Value
End With
End If
fichier = Dir()
Loop
End If
'On colle le compteur dans la cellule E6
Range("E6").Select
ActiveCell.Value = compteur
End Sub
J'ai encore avancé. je bute juste sur un point:
Ma boucle se fait juste sur le déplacement de I=7 to 81 mais mon calcul ne se boucle pas mais se calcule en une seule fois si bien que en G8 à G81 de mon fichier Dépouillement j'ai le même résultat que dans G7 de mon dépouillement.
Help please
Voir le code suivant
Sub sommescellule_somm7()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim compteur As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'On renseigne le compteur à 0
compteur = 0
'Sélection du répertoire
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'format du fichier (par exemple xlsx)
fichier = Dir(Chemin & "*.xlsx")
For I = 7 To 81
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
'la cellule qui va être recherchée dans les autres classeurs est G9 de la feuille 1
ThisWorkbook.Names.Add "Plage", _
RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$G$" & I
'on va coller le résultat dans ce classeur feuille List_Resulats
With Sheets("List_Resulats")
.Range("G" & I) = "=Plage"
'on ajoute le résultat trouvé dans le compteur
compteur = compteur + .Range("G" & I).Value
'compteur = compteur + .[G&I].Value
End With
End If
fichier = Dir()
Loop
'On colle le compteur dans // Je soupçonne que c'est cette ligne qui fait que j'ai la même somme partout
Range("G" & I).Select
ActiveCell.Value = compteur
Next I
End Sub
J'ai finalement trouvé avec beaucoup de mal.Merci.Je posterai les codes après les avoir documentés pour une meilleure compréhension.