VBA: (ByVal Target As Range) - Problème avec plusieurs Range

Le 07/09/2017 à 11:45

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 !

Le 07/09/2017 à 12:13

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
Le 07/09/2017 à 13:01

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 !

Le 07/09/2017 à 13:19

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 ?

Le 07/09/2017 à 18:39

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

Le 08/09/2017 à 07:13

Parfait, ça fonctionne !

Merci pour votre aide

Amicalement,

Rechercher des sujets similaires à "vba byval target range probleme"