Plusieurs Private Sub Worksheet_Change sur même feuille

Bonjour,

Voici ci-dessous un code VB qui me permet d'incrémenter une cellule en passant par une autre :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Message As String, Valeur As Long

With Target

If Not .Address(False, False) = "K64" Then Exit Sub

Valeur = .Value

Message = "Valider le rajout de " & Valeur & " m3 au cubage annuel"

If MsgBox(Message, vbYesNo) = vbNo Then Exit Sub

Range("H49").Value = Range("H49").Value + Valeur

Application.EnableEvents = False

.Value = Empty

Application.EnableEvents = True

Call Macro998

End With

End Sub

Mon soucis est que j'aimerai, dans la même feuille faire la même chose pour une autre matière !

Par exemmple taper une valeur en H64 pour incrémenter la cellule en F40.

Comment puis-je procéder s'il vous plait ?

Merci par avance.

Bonjour

Une compilation des 2 codes

A tester

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Message As String, Valeur As Long

  With Target
    If .Address(False, False) = "K64" Then
      Valeur = .Value
      Message = "Valider le rajout de " & Valeur & " m3 au cubage annuel"
      If MsgBox(Message, vbYesNo) = vbNo Then Exit Sub
      Range("H49").Value = Range("H49").Value + Valeur
      Application.EnableEvents = False
      .Value = Empty
      Application.EnableEvents = True
      Call Macro998
    ElseIf .Address(False, False) = "H64" Then
      Valeur = .Value
      If MsgBox("Valider le rajout de " & Valeur & " je ne sais pas", vbQuestion + vbYesNo) <> vbYes Then Exit Sub
      Range("F40").Value = Range("F40").Value + Valeur
      Application.EnableEvents = False
      .Value = Empty
      Application.EnableEvents = True
      Call Macro998
    End If
  End With
End Sub

Bonjour,

Cela parait à chaque fois tout bête une fois que l'on a la solution sous les yeux !

Ca fonctionne très bien et vous remercie sincèrement.

Merci encore et bonne continuation............. surtout à bientôt

David

Rechercher des sujets similaires à "private sub worksheet change meme feuille"