VBA: (ByVal Target As Range) - Problème avec plusieurs Range
Bonjour à tous,
Un problème sans doute basique pour des bons connaisseurs VBA, mais pour moi c'est une difficulté
J'ai un code qui permet de saisir une donnée dans une cellule qui actionne ensuite des actions (collage, formule) sur les colonnes correspondantes. Ce bout de code fonctionnement parfaitement!
Je cherche maintenant à appliquer exactement le même code mais sur une zone différente...j'ai pensé à copier/coller le code complet, mais impossible d'avoir un "Private Sub Worksheet_Change(ByVal Target As Range)" à double...
La solution serait de mettre les 2 codes à la suite...mais je n'y arrive pas !
Quelqu'un pour me sauver ?
Code qui fonctionne:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ligne As Integer
'
Set KeyCells = Range("col_legume")
On Error Resume Next
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Range(Target.Address).Value = "CAROTTE" Then
ligne = Range(Target.Address).Row
Range("Q" & ligne).FormulaR1C1 = "=IFERROR(FLOOR(R6C12,5),"""")"
'Range("Q" & ligne).Copy
Range("K6").Copy
Range("r" & ligne).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
Exit Sub
End If
End If
End Sub
Code "à fusionner"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ligne As Integer
'
Set KeyCells = Range("col_fruit")
On Error Resume Next
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Range(Target.Address).Value = "CAROTTE" Then
ligne = Range(Target.Address).Row
Range("U" & ligne).FormulaR1C1 = "=IFERROR(FLOOR(R6C12,5),"""")"
'Range("U" & ligne).Copy
Range("K6").Copy
Range("V" & ligne).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
Exit Sub
End If
End If
End Sub
D'avance un grand merci pour votre aide !
- Messages
- 4'093
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ligne As Integer
'
Set KeyCells = Union(Range("col_legume"), Range("col_fruit"))
On Error Resume Next
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
If Target.Value = "CAROTTE" Then
ligne = Target.Row
Range("Q" & ligne).FormulaR1C1 = "=IFERROR(FLOOR(R6C12,5),"""")"
Range("K6").Copy
Range("r" & ligne).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
Exit Sub
End If
End If
End Sub
Bonjour
Essaie ça :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ligne As Integer
Application.EnableEvents = False
Set KeyCells = Union(Range("col_legume"), Range("col_fruit"))
On Error Resume Next
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Range(Target.Address).Value = "CAROTTE" Then
ligne = Range(Target.Address).Row
Range("Q" & ligne).FormulaR1C1 = "=IFERROR(FLOOR(R6C12,5),"""")"
'Range("Q" & ligne).Copy
Range("K6").Copy
Range("r" & ligne).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
Exit Sub
End If
End If
Application.EnableEvents = True
End Sub
Résultat ?
Bye !
Hello,
Merci pour vos réponses.
Petit détail que je n'ai pas précisé: sur le code "à fusionner", certaines range sont également différentes (U à la place de Q, V à la place de R). Possible également d'intégrer ces changement au code ?
- Messages
- 4'093
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonsoir,
Avec l'hypothèse que tes 2 plages correspondent à 2 colonnes distinctes, ce que leur dénomination laisse supposer :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ligne As Integer
'
Set KeyCells = Union(Range("col_legume"), Range("col_fruit"))
On Error Resume Next
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
If Target.Value = "CAROTTE" Then
ligne = Target.Row
If Target.Column = Range("col_legume").Column Then Range("Q" & ligne).FormulaR1C1 = "=IFERROR(FLOOR(R6C12,5),"""")"
If Target.Column = Range("col_fruit").Column Then Range("U" & ligne).FormulaR1C1 = "=IFERROR(FLOOR(R6C12,5),"""")"
Range("K6").Copy
If Target.Column = Range("col_legume").Column Then Range("r" & ligne).PasteSpecial Paste:=xlPasteValues
If Target.Column = Range("col_fruit").Column Then Range("v" & ligne).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
Exit Sub
End If
End If
End Sub
Parfait, ça fonctionne !
Merci pour votre aide
Amicalement,