Ajouter/Sauvegarder des valeurs issues d'un calcul précédent.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nouveau As Single
If Not Intersect(Target, Range("B4:B8")) Is Nothing Then
If Application.Sum([B4:B8]) = 0 Then
With Application
.EnableEvents = False
.Undo
[E9] = [E9] + [B9]
[B4:B8] = ""
.EnableEvents = True
End With
End If
End If
End Sub 

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A8")) Is Nothing Then
If Application.WorksheetFunction.CountA([A2:A8]) = 0 Then
With Application
.EnableEvents = False
.Undo
[E9] = [E9] + [B9]
[A2:B8] = ""
.EnableEvents = True
End With
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A3:B7")) Is Nothing Then
If Application.WorksheetFunction.CountA([A3:B7]) = 0 Then
With Application
.EnableEvents = False
.Undo
[C13] = [C13] + [F8]
[C14] = [C14] + [G8]
[A3:B7] = ""
.EnableEvents = True
End With
End If
End If
End Sub 

Private Sub CommandButton1_Click()
If Application.WorksheetFunction.CountA([A3:B7]) = 10 Then
[C13] = [C13] + [F8]
[C14] = [C14] + [G8]
Union([A3:B7], [I3:I7]) = ""
End If
End Sub 

Private Sub CommandButton1_Click()
If Application.WorksheetFunction.CountA([A3:B7]) > 0 Then
If MsgBox("Etes-vous certain de vouloir archiver les données avant de les supprimer", vbYesNo, "Demande de confirmation") = vbYes Then
[C13] = [C13] + [F8]
[C14] = [C14] + [G8]
Union([A3:B7], [I3:I7]) = ""
End If
Else
MsgBox "Aucune valeur a archiver n'a été touvée.", , "Procédure abandonnée !"
End If

Private Sub CommandButton1_Click()
If Application.WorksheetFunction.CountA([A3:B7]) > 0 Then
If MsgBox("Etes-vous certain de vouloir archiver les données avant de les supprimer", vbYesNo, "Demande de confirmation") = vbYes Then
[C14] = [C14] + [J8]
[C13] = [C13] + [F8]
Union([A3:B7], [I3:I7]) = ""
End If
Else
MsgBox "Aucune valeur a archiver n'a été touvée.", , "Procédure abandonnée !"
End If
End Sub