Voici la macro qu'une personne a réalisé sur le forum.
La macro ouvre les fichier du dossier et fait une addition des cellules.
Exemple:
Dans le fichier TOTAL on veut l'addition des autres fichiers c'est à dire que dans le fichier TOTAL la Cellule L10 sera le résultat de l'addition des cellules L10 des autres fichiers du dossier. Celà implique alors que les fichiers soit tous identiques au niveau de leur structure. J'aimerai donc quelque chose pour vérifier ça. En vérifiant que la cellule H10 soit bien égal à la référence (valeur) 3197000 et H501 à 7992607. S'ils ne répondent pas à ces conditions il faudrait arrêter la macro afin de pas fausser le total.
Je pense qu'il faut le faire au niveau :
For Each cel In ThisWorkbook.Sheets("CARITA 2010 Mkt Plan FORECAST").Range("L10:Q501") 'boucle 1 : sur toutes les cellules cel de la plage L10:Q501 de l'onglet "CARITA 2010 Mkt Plan FORECAST"
If cel.Interior.ColorIndex = 38 Then 'condition 1 : si le couleur de fond de la cellule est rose
J'ai tenté de faire quelque chose comme If Cells.Value(10, 8) <> 3197000 Or Cells.Value(501, 8) <> 7992607 Then 'boucle 0
Exit For
End If
J'espère avoir été clair et que vous m'aiderez.
Merci
Code:
Sub Macro1()
Dim chem As String 'déclare la variable chem (CHEMin d accès)
Dim fs, d, f1, fd 'déclare les variables fs, d, f1 et fd
Dim cel As Range 'déclare la variable cel (CELlule)
Dim cl As Workbook 'déclare la varaible cl (CLasseur)
Dim t As Double 'déclare la variable t (Total)
'***********************
'ouverture des classeurs
'***********************
chem = ThisWorkbook.Path & "\" 'définit le chemin, ici c'est le dossier courant
Set fs = CreateObject("Scripting.FileSystemObject") 'définit la variable fs (Fichiers Système)
Set d = fs.GetFolder(chem) 'definit la variable d (dossier)
Set fd = d.Files 'définit la variable fd (Fichiers du Dossier)
For Each f1 In fd 'boucle sur tous les fichier du dossier
If f1.Name <> "Carita - TOTAL.xls" Then Workbooks.Open chem & f1.Name 'ouvre le fichier
Next f1
'*****************
'calcul des totaux
'*****************
For Each cel In ThisWorkbook.Sheets("CARITA 2010 Mkt Plan FORECAST").Range("L10:Q501") 'boucle 1 : sur toutes les cellules cel de la plage L10:Q501 de l'onglet "CARITA 2010 Mkt Plan FORECAST"
If cel.Interior.ColorIndex = 38 Then 'condition 1 : si le couleur de fond de la cellule est rose
For Each cl In Workbooks 'boucle 2 : sur tous les classeurs ouverts
If cl.Name <> ThisWorkbook.Name Then 'condition 2 : si le nom du classseur est différent du nom de celui-ci
'redéfinit la variable t si la cellule correspondante est numérique
If IsNumeric(cl.Sheets("CARITA 2010 Mkt Plan FORECAST").Range(cel.Address)) Then t = t + CDbl(cl.Sheets("CARITA 2010 Mkt Plan FORECAST").Range(cel.Address))
End If 'fin de la condition 2
Next cl 'prochain classeur de la boucle 2
cel.Value = t 'place t dans la cellule cel
t = 0
End If 'fin de la condition 1
Next cel 'prochaine cellul cel de la boucle 1
'***********************
'fermeture des classeurs
'***********************
For Each cl In Workbooks
If cl.Name <> ThisWorkbook.Name Then cl.Close SaveChanges:=False 'ferme le fichier
Next cl
End SubLa macro ouvre les fichier du dossier et fait une addition des cellules.
Exemple:
Dans le fichier TOTAL on veut l'addition des autres fichiers c'est à dire que dans le fichier TOTAL la Cellule L10 sera le résultat de l'addition des cellules L10 des autres fichiers du dossier. Celà implique alors que les fichiers soit tous identiques au niveau de leur structure. J'aimerai donc quelque chose pour vérifier ça. En vérifiant que la cellule H10 soit bien égal à la référence (valeur) 3197000 et H501 à 7992607. S'ils ne répondent pas à ces conditions il faudrait arrêter la macro afin de pas fausser le total.
Je pense qu'il faut le faire au niveau :
For Each cel In ThisWorkbook.Sheets("CARITA 2010 Mkt Plan FORECAST").Range("L10:Q501") 'boucle 1 : sur toutes les cellules cel de la plage L10:Q501 de l'onglet "CARITA 2010 Mkt Plan FORECAST"
If cel.Interior.ColorIndex = 38 Then 'condition 1 : si le couleur de fond de la cellule est rose
J'ai tenté de faire quelque chose comme If Cells.Value(10, 8) <> 3197000 Or Cells.Value(501, 8) <> 7992607 Then 'boucle 0
Exit For
End If
J'espère avoir été clair et que vous m'aiderez.
Merci
