Additionner deux cellules par macro

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion eduraiss
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
E

eduraiss

XLDnaute Accro
Bonjour le forum

Voila j'ai trois fichiers A B C

Des fichiers A et B je veux extraite les valeurs qui se trouvent en A5

Exemple:
fichier A A5 = 10
Fichier B a5 = 15

je voudrais copier par macro ses deux valeurs dans le fichier C en cellule A1 , mais je voudrais avoir l'addition soit A1=25

Est-ce possible

Merci de votre aide
Difficile de faire un fichier joint
 
Trier par date Trier par votes
Re : Additionner deux cellules par macro

bonsoir

s'il s'agit de lire dans des fichiers différents voir ce sub !?

Code: 
Sub CopyCellDunClasseurFermeDansCeClasseur()
' variables à adapter ------------------------------------------

'pour lire le premier classeur
ClasseurSource$ = "?????.xls"
FeuilSource$ = "?????": RangSource$ = "???"
FeuilDestin$ = "?????": RangDestin$ = "???"
GoSub Transfert
'check la 1' valeur copiée
SvgDonn1$ = ThisWorkbook.Sheets(FeuilDestin$).Range(RangDestin$)
'pour lire le deuxième classeur
ClasseurSource$ = "?????.xls"
FeuilSource$ = "?????": RangSource$ = "???"
FeuilDestin$ = "?????": RangDestin$ = "???"
GoSub Transfert
'check la 2' valeur copiée
SvgDonn2$ = ThisWorkbook.Sheets(FeuilDestin$).Range(RangDestin$)
'recopie le total des deux
ThisWorkbook.Sheets(FeuilDestin$).Range(RangDestin$) = Val(SvgDonn1$) + Val(SvgDonn2$)
Exit Sub
'-------------------------------------------------------------------------------------

' routine transfert...(ne rien modifier ci-dessous)
Transfert:
Application.CutCopyMode = False: Application.ScreenUpdating = False: Application.DisplayAlerts = False
Workbooks.Open Filename:=ClasseurSource$
Workbooks(ClasseurSource$).Sheets(FeuilSource$).Range(RangSource$).Copy _
 Destination:=ThisWorkbook.Sheets(FeuilDestin$).Range(RangDestin$)
Workbooks(ClasseurSource$).Close 'fin
ThisWorkbook.Activate
Application.CutCopyMode = False: Application.DisplayAlerts = True: Application.ScreenUpdating = True
Return
End Sub

Roland
 
Vote positif 0 Vote négatif
Re : Additionner deux cellules par macro

Bonjour le forum

je reviens avec ce post, j'ai bien essayer d'adapter les codes qui fonctionnent bien pour ce que j'ai demandé, mais qui ne peuvent correspondre a ce qu'il me faut vraiment.

En effet comme dirait Roland il faut établir un cahier des charges précis, et il ne l'était pas a la base

La complexité de cette demande me fait dire que je ferais mieux de rentrer mes valeur sans automatiser

Désolé de vous avoir demandé de m'aider.

Merci beaucoup tout de même
 
Vote positif 0 Vote négatif
Re : Additionner deux cellules par macro

Bonjour Eduraiss, Roland, Sergio

si il s'agit de faire une addition, le code qui suit devrait suffire, enfin me semble t'il, avec se que j'ai compris :

Code: 
Workbooks("classeur1.xls").Sheets("Feuil1").Range("A1").Value = _
    Workbooks("classeur2.xls").Sheets("Feuil1").Range("A5").Value + _
    Workbooks("classeur3.xls").Sheets("Feuil1").Range("A5").Value

bonne journée.
@+

Edition : noms des classeurs et des feuilles à adapter.
 
Vote positif 0 Vote négatif
Re : Additionner deux cellules par macro

Re bonjour au forum et a ceux qui mon répondu

Aller cela ne fait rien je me lance, en essayant de faire plus simple

Deux fichiers A et B

A est un fichier qui change de nom ainsi que le noms des feuilles (jour de la semaine)
B est un fichier que je dois ouvrir de A mais qui ne change pas
Name:stat interim et la
feuille: base
Dans le fichier A une date en F1 que je dois retrouver dans le fichier B (feuille base ) en colonne B une fois cette date trouver je reviens sur le fichier A je récupère la valeur en A3 que je colle en colonne C du fichier B idem pour A4 je colle en D idem pour A5 que je colle en E et A6 en F ses quatre valeurs doivent être additionner si il existe une valeur dèja existante (voir pour msgbox pour avertir)

Il ne reste que deux valeur a coller du fichier A vers le fichier B mais là pas d'addition on colle uniquement la valeur
Dans le fichier A je récupère A10 et je la colle dans le fichier B en colonne G
eT A13 en colonne H

Je ne sais pas si c'est clair

Merci a vous
 
Vote positif 0 Vote négatif
Re : Additionner deux cellules par macro

Bonjoru le forum

Merci Roland pour ton fichier, j'ai gratté pas mal et j'aui réussi a l'adatpter a mon projet. voici le code tranformer, je pense qu'il doit y avoir plus simple, mais le principal y est cela fonctionne.

Un grand merci une nouvelle fois
Cordialement,

Private Sub CommandButton37_Click()
Dim Reponse As Variant 'pour Msgbox
Application.ScreenUpdating = False
DateRecherche$ = ActiveSheet.Cells(1, "F") 'la date en F1 Feuil(1)
x = ActiveWorkbook.Name
'============================
'POUR LES DEUX FICHIER
ValeurSource = Val(ActiveSheet.Range("A3")) 'valeur en "A3" Feuil(1)
ValeurSource1 = Val(ActiveSheet.Range("A4")) 'valeur en "A4" Feuil(1)
ValeurSource2 = Val(ActiveSheet.Range("A5")) 'valeur en "A5" Feuil(1)
ValeurSource3 = Val(ActiveSheet.Range("A6")) 'valeur en "A6" Feuil(1)
'z2 m2
ValeurSource4 = Val(ActiveSheet.Range("A10")) 'valeur en "A6" Feuil(1)
ValeurSource5 = Val(ActiveSheet.Range("A13")) 'valeur en "A6" Feuil(1)
'z1a z1b z1c
ValeurSource6 = Val(ActiveSheet.Range("A11")) 'valeur en "A6" Feuil(1)
ValeurSource7 = Val(ActiveSheet.Range("A14")) 'valeur en "A6" Feuil(1)
ValeurSource8 = Val(ActiveSheet.Range("A17")) 'valeur en "A6" Feuil(1)




'======================================
Windows("STAT INTERIMAIRE.xls").Activate
DernLig = Sheets("BASE").Columns("B").End(xlDown).Row 'dern lig des dates en colonne(B)

'recherche date en colonne B Feuil(BASE)

'==========================================

For L = 2 To DernLig
d$ = Sheets("BASE").Cells(L, "B")
If d$ = DateRecherche$ Then
If Sheets("BASE").Cells(L, "C") > 0 Then 'si valeur demande pour additionner
M$ = "Il y a déjà une valeur dans la cellule de destination" & vbLf & _
"Voulez-vous l'additionner ?" & vbLf & "(sinon elle sera coller simplement)"
Reponse = MsgBox(M$, vbQuestion + vbYesNoCancel, "Coller valeur")
If Reponse = vbYes Then
Sheets("BASE").Cells(L, "C") = Sheets("BASE").Cells(L, "C") + ValeurSource
ElseIf Reponse = vbNo Then
Sheets("BASE").Cells(L, "C") = ValeurSource
End If
Else 'si aucune valeur colle directement
Sheets("BASE").Cells(L, "C") = ValeurSource
End If
End If
Next
'================================================
For L = 2 To DernLig
d$ = Sheets("BASE").Cells(L, "B")
If d$ = DateRecherche$ Then
If Sheets("BASE").Cells(L, "D") > 0 Then 'si valeur demande pour additionner
M$ = "Il y a déjà une valeur dans la cellule de destination" & vbLf & _
"Voulez-vous l'additionner ?" & vbLf & "(sinon elle sera coller simplement)"
Reponse = MsgBox(M$, vbQuestion + vbYesNoCancel, "Coller valeur")
If Reponse = vbYes Then
Sheets("BASE").Cells(L, "D") = Sheets("BASE").Cells(L, "D") + ValeurSource1
ElseIf Reponse = vbNo Then
Sheets("BASE").Cells(L, "D") = ValeurSource1
End If
Else 'si aucune valeur colle directement
Sheets("BASE").Cells(L, "D") = ValeurSource1
End If
End If
Next
'=======================================================
For L = 2 To DernLig
d$ = Sheets("BASE").Cells(L, "B")
If d$ = DateRecherche$ Then
If Sheets("BASE").Cells(L, "E") > 0 Then 'si valeur demande pour additionner
M$ = "Il y a déjà une valeur dans la cellule de destination" & vbLf & _
"Voulez-vous l'additionner ?" & vbLf & "(sinon elle sera coller simplement)"
Reponse = MsgBox(M$, vbQuestion + vbYesNoCancel, "Coller valeur")
If Reponse = vbYes Then
Sheets("BASE").Cells(L, "E") = Sheets("BASE").Cells(L, "E") + ValeurSource2
ElseIf Reponse = vbNo Then
Sheets("BASE").Cells(L, "E") = ValeurSource2
End If
Else 'si aucune valeur colle directement
Sheets("BASE").Cells(L, "E") = ValeurSource2
End If
End If
Next
'=======================================================
For L = 2 To DernLig
d$ = Sheets("BASE").Cells(L, "B")
If d$ = DateRecherche$ Then
If Sheets("BASE").Cells(L, "F") > 0 Then 'si valeur demande pour additionner
M$ = "Il y a déjà une valeur dans la cellule de destination" & vbLf & _
"Voulez-vous l'additionner ?" & vbLf & "(sinon elle sera coller simplement)"
Reponse = MsgBox(M$, vbQuestion + vbYesNoCancel, "Coller valeur")
If Reponse = vbYes Then
Sheets("BASE").Cells(L, "F") = Sheets("BASE").Cells(L, "F") + ValeurSource3
ElseIf Reponse = vbNo Then
Sheets("BASE").Cells(L, "F") = ValeurSource3
End If
Else 'si aucune valeur colle directement
Sheets("BASE").Cells(L, "F") = ValeurSource3
End If
End If
Next
'=======================================================
For L = 2 To DernLig
d$ = Sheets("BASE").Cells(L, "B")
If d$ = DateRecherche$ Then
If Sheets("BASE").Cells(L, "G") > 0 Then 'si valeur demande pour additionner
M$ = "Il y a déjà une valeur dans la cellule de destination" & vbLf & _
"Voulez-vous l'additionner ?" & vbLf & "(sinon elle sera coller simplement)"
Reponse = MsgBox(M$, vbQuestion + vbYesNoCancel, "Coller valeur")
If Reponse = vbYes Then
Sheets("BASE").Cells(L, "G") = Sheets("BASE").Cells(L, "G") + ValeurSource4
ElseIf Reponse = vbNo Then
Sheets("BASE").Cells(L, "G") = ValeurSource4
End If
Else 'si aucune valeur colle directement
Sheets("BASE").Cells(L, "G") = ValeurSource4
End If
End If
Next
'=======================================================
For L = 2 To DernLig
d$ = Sheets("BASE").Cells(L, "B")
If d$ = DateRecherche$ Then
If Sheets("BASE").Cells(L, "H") > 0 Then 'si valeur demande pour additionner
M$ = "Il y a déjà une valeur dans la cellule de destination" & vbLf & _
"Voulez-vous l'additionner ?" & vbLf & "(sinon elle sera coller simplement)"
Reponse = MsgBox(M$, vbQuestion + vbYesNoCancel, "Coller valeur")
If Reponse = vbYes Then
Sheets("BASE").Cells(L, "H") = Sheets("BASE").Cells(L, "H") + ValeurSource5
ElseIf Reponse = vbNo Then
Sheets("BASE").Cells(L, "H") = ValeurSource5
End If
Else 'si aucune valeur colle directement
Sheets("BASE").Cells(L, "H") = ValeurSource5
End If
End If
Next
'=======================================================
Workbooks(x).Activate
Unload Me

End Sub
 
Vote positif 0 Vote négatif
Re : Additionner deux cellules par macro

bonjour

ta routine simplifiée (une seule suffit) voir appel en sous prog

Code: 
Private Sub CommandButton37_Click()
Dim Reponse As Variant 'pour Msgbox
Application.ScreenUpdating = False
SvgClassActif$ = ActiveWorkbook.Name
'POUR LES DEUX FICHIERS !!! ne pas oublier le (.) exemple .Range("A3")
With ActiveSheet
DateRecherche$ = .Cells(1, "F") 'la date en "F1" Feuil(1)
ValeurSource = Val(.Range("A3")) 'valeur en "A3" Feuil(1)
ValeurSource1 = Val(.Range("A4")) 'valeur en "A4" Feuil(1)
ValeurSource2 = Val(.Range("A5")) 'valeur en "A5" Feuil(1)
ValeurSource3 = Val(.Range("A6")) 'valeur en "A6" Feuil(1)
'z2 m2
ValeurSource4 = Val(.Range("A10")) 'valeur en "A6" Feuil(1)
ValeurSource5 = Val(.Range("A13")) 'valeur en "A6" Feuil(1)
'z1a z1b z1c
ValeurSource6 = Val(.Range("A11")) 'valeur en "A6" Feuil(1)
ValeurSource7 = Val(.Range("A14")) 'valeur en "A6" Feuil(1)
ValeurSource8 = Val(.Range("A17")) 'valeur en "A6" Feuil(1)
End With

'-------- init variables pour appel sous prog ---------
' 1' ValSource  = ValeurSource  ValeurSource1 .........
' 2' ColDestin$ = colonne > "C" "D" "E" "F" "G" "H" ...
Windows("STAT INTERIMAIRE.xls").Activate
DernLig = Sheets("BASE").Columns("B").End(xlDown).Row 'dern lig des dates en colonne(B)
'
ColDestin$ = "C": ValSource = ValeurSource: GoSub SousProg
ColDestin$ = "D": ValSource = ValeurSource1: GoSub SousProg
ColDestin$ = "E": ValSource = ValeurSource2: GoSub SousProg
ColDestin$ = "F": ValSource = ValeurSource3: GoSub SousProg
ColDestin$ = "G": ValSource = ValeurSource4: GoSub SousProg
ColDestin$ = "H": ValSource = ValeurSource5: GoSub SousProg

'......... tu peux continuer de la même manière ...........




'------------ fin reactive classeur et quitte -----------------
Workbooks(SvgClassActif$).Activate: Unload Me: Exit Sub 'quitte


SousProg: 'sous prog recherche date en colonne B Feuil(BASE)
' Variables initialisées avant appel
' Var1: ValSource qui est = ValeurSource(no)
' Var2: ColDestin$ = "C" "D" "E" "F" "G" "H" ...
For L = 2 To DernLig
D$ = Sheets("BASE").Cells(L, "B")
If D$ = DateRecherche$ Then
If Sheets("BASE").Cells(L, ColDestin$) > 0 Then 'si valeur demande pour additionner
M$ = "Il y a déjà une valeur dans la cellule de destination" & vbLf & _
"Voulez-vous l'additionner ?" & vbLf & "(sinon elle sera collée simplement)"
Reponse = MsgBox(M$, vbQuestion + vbYesNoCancel, "Coller valeur")
If Reponse = vbYes Then
Sheets("BASE").Cells(L, ColDestin$) = Sheets("BASE").Cells(L, ColDestin$) + ValSource
ElseIf Reponse = vbNo Then
Sheets("BASE").Cells(L, ColDestin$) = ValSource
End If
Else 'si aucune valeur colle directement
Sheets("BASE").Cells(L, ColDestin$) = ValSource
End If
End If
Next
Return
End Sub

Roland
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

P
  • Question Question
Microsoft 365 Mettre en surbrillance les trois cellules avec les plus grandes valeurs
Réponses
4
Affichages
297
Perceval973
P
M
  • Résolu(e)
XL 2021 copier des cellules
Réponses
9
Affichages
337
Phil69970
Phil69970
P
  • Résolu(e)
XL 2021 Formule avec SI ET et si possible plusieurs ET
Réponses
4
Affichages
307
PR.
P
B
  • Question Question
XL 2021 VBA pour générer une liste de valeurs comprise entre 2 valeurs
2
Réponses
16
Affichages
777
benjy555
B
treza88
  • Résolu(e)
XL 2021 Temps réel d'éxécution macro
Réponses
3
Affichages
261
treza88
treza88
jlbcall
  • Question Question
Microsoft 365 Power Query
Réponses
8
Affichages
404
jlbcall
jlbcall
N
  • Résolu(e)
Microsoft 365 Macro entre 2 classeurs
2
Réponses
19
Affichages
767
Nounours4173
N
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
746
un internaute
U
U
  • Question Question
Autres [RÉSOLU] Comment faire masquer mes plages de cellules vides par macro
2
Réponses
17
Affichages
762
un internaute
U
ARaul
  • Question Question
XL 2019 Copier et coller automatiquement une nouvelle donnée par un bouton, ListView décallée à la sur la page (Multipage) et vibration du Userform
2
Réponses
16
Affichages
977
TooFatBoy
TooFatBoy
R
  • Question Question
XL 2010 Copie de plusieurs plages de cellules spécifiques dans le presse-papier
2
Réponses
20
Affichages
940
Dranreb
Dranreb
M
  • Question Question
XL 2016 pb création de tableau par macro
Réponses
10
Affichages
411
ChTi160
ChTi160
N
  • Résolu(e)
Microsoft 365 Macro enregistrement automatique pdf
2
Réponses
18
Affichages
1 K
Nounours4173
N
N
  • Résolu(e)
XL 2019 Macro pour copier ligne avec case à cocher liée
Réponses
12
Affichages
557
Phil69970
Phil69970
P
  • Résolu(e)
XL 2016 VBA Insérer une date dans le nom de fichiers PDF publipostés via WORD à partir d"excel
Réponses
3
Affichages
733
PHIL37
P
A
  • Question Question
Microsoft 365 Macro pour recherche de cellules entre 2 fichiers Excel
Réponses
7
Affichages
536
AtTheOne
AtTheOne
M
  • Résolu(e)
XL 2013 Macross supprimant les données de cellule en dehors d'une période définie dans deux autres cellules
Réponses
9
Affichages
810
MarineU
M
P
  • Question Question
XL 2019 Macro VBA appliquer un filtre lors d'une importation de données
Réponses
1
Affichages
575
fanch55
fanch55
B
  • Question Question
XL 2019 Dans une macro de démarrage de fichier masquer le code par des Astérix ou point
Réponses
3
Affichages
552
sylvanu
sylvanu
D
  • Question Question
Power Query query - calculer le taux de tva
Réponses
5
Affichages
558
JFL_XLD
J
Retour