Worsheet_Change / Critère Validé / Recherche sur une autre feuille

Bonjour à tous, je vous souhaite à tous une bonne année et mes meilleurs vœux.

Je vous sollicite une nouvelle fois pour pouvoir finaliser, bientôt je l'espère, mon projet de gestion de stock.

Pour chaque bon commande validé via un userform, une colonne est créé en feuille "produits" à partir de la colonne n°28 et une ligne est créé en feuille "commande" à partir de ligne n°3.

J'aimerai vérifier pour chaque changement de la feuille "commande", si la valeur des cellules en colonne E = "reçu".

Si c'est le cas voici l'exécution de la macro que j'essaye de réaliser :

• On cherche une correspondance entre la ligne en question et la colonne associée en feuille "produits"
• Lorsque la colonne est trouvé on colorie le fond de la colonne

Voici mon ébauche de code pour matérialiser mes explications qui sont certainement encore un peu floues.

Aujourd'hui quand je teste cette macro rien ne se passe.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim fr As Worksheet
Dim DerCol, DerLg, i As Integer

Set fr = Sheets("Produits")

If Not Intersect(Target, Range("E:E")) Is Nothing Then

    If Target.Address = "Reçu" Then

        Application.EnableEvents = False

        With fr
        'Dernière ligne de la feuille
        DerLg = .Range("A" & Rows.Count).End(xlUp).Row
        'Dernière colonne de la feuille
        DerCol = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
            'Boucle sur toutes les colonnes en commençant de la colonne 28
            For i = 28 To DerCol
            'Recherche correspondance avec la référence de commande et la date de commande
                If .Cells(2, i) = Target.Offset(0, -2) And .Cells(3, i) = Target.Offset(0, -4) Then
                    .Columns("i").Interior.Color = RGB(219, 219, 219)
                    Exit For
                End If
            Next i
        End With

        Application.ScreenUpdating = False

    End If
End If

End Sub

Voici un fichier exemple :

Merci par avance pour votre aide !

Bonne journée

Bonjour

Quelques modifications :

1. Target.Address renvoie E3 et non pas "Reçu". Donc remplacez -->

If Target.Address = "Reçu" Then

par

If Target.value = "Reçu" Then

2. Supprimer la ligne "Application.EnableEvents = False". Evitez cette instruction qui suspend les évènements ou tout au moins il faut remettre la valeur à TRUE en sortant du code.

3. Ajouter un point juste avant ROWS.COUNT -->

DerLg = .Range("A" & .Rows.Count).End(xlUp).Row

4. Ajouter un point avant CELLS.COLUMN -->

DerCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column

Plus bas, vous utilisez .Columns("i"). Là vous coloriez toute la colonne, y compris les cellules qui n'ont pas de données (donc plus d'un million de cellules...). Normal que ce soit toute la colonne à colorier ?

Cordialement

Bonjour Dan,

Merci pour votre retour et vos corrections.

Voici le code modifié :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim fr As Worksheet
Dim DerCol, DerLg, i As Integer
'sCol As String

Set fr = Sheets("Produits")

If Not Intersect(Target, Range("E:E")) Is Nothing Then

    If Target.Value = "Reçu" Then

        Application.EnableEvents = True

        With fr
        'Dernière ligne de la feuille
        DerLg = .Range("A" & .Rows.Count).End(xlUp).Row
        'Dernière colonne de la feuille
        DerCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
            'Boucle sur toutes les colonnes en commençant de la colonne 28
            For i = 28 To DerCol
            'Recherche correspondance avec la référence de commande et la date de commande
                If .Cells(2, i) = Target.Offset(0, -2) And .Cells(3, i) = Target.Offset(0, -4) Then
                    .Columns("i").Interior.Color = RGB(219, 219, 219)
                    Exit For
                End If
            Next i
        End With

        Application.ScreenUpdating = False

    End If
End If

End Sub

J'utilise .Columns("i") parce que je ne sait pas faire autrement malheureusement.

Si il y a une manière pour gagner du temps dans l'exécution de la macro je suis ouvert à toutes solutions.

Avec ces modifications la macro fonctionne mais il y a un problème.

Sur mon fichier test ci-joint, la colonne qui est coloriée n'est celle qui devrait être colorié.

Je souhaite que le remplissage de fond se fasse sur la colonne correspondante à la ligne validée "reçu" en feuille "commande".

Merci encore pour votre aide.

re

Vous pouvez supprimer cette ligne -> Application.EnableEvents = True. Si je comprends ce que vous cherchez à faire, cela ne sert pas ici

la colonne qui est coloriée n'est celle qui devrait être colorié.

Expliquez moi par exemple ce que vous faites

Bonjour Dan,

Je crois que je m'embrouille avec cette fonction.

Voici comment je souhaite utiliser ce fichier :

1. Je crée un bon de commande et je le finalise

Quand le bon est validé il se passe deux choses :

• Les données du bon sont enregistrées en feuille produits dans une nouvelle colonne commençant à la colonne "AB"
• Les données du bon sont enregistrées en feuille commande dans une nouvelle ligne à partir de la ligne 3

Dans mon fichier exemple, la macro que je souhaite mettre au point fait buguer l'ensemble du fichier

Voici la colonne créé en feuille produits par la macro "Ins_CoProduits"

Et voici la ligne crée en feuille commande par la macro "Ins_CoBons"

Imaginons qu'il y a une centaine de colonnes en feuilles produits et donc une centaine de lignes en feuille commande.

Je souhaite que lorsque je valide la celulle "Reçu" de la ligne du bon du commande "test1" alors

la colonne du bon de commande "test1" doit se colorier.

Dans mon code je cherche la correspondance entre la ligne en feuille commande et la colonne en feuille produits de cette manière :

 If .Cells(2, i) = Target.Offset(0, -2) And .Cells(3, i) = Target.Offset(0, -4) Then

Je vérifie si la référence et la date correspondent pour plus de sécurité au cas où un bon de commande aurait la même référence.

J'espère être plus clair et précis dans l'explication de mon problème.

Des fois des images sont plus parlantes que des mots, surtout dans mon cas.

Merci à nouveau pour votre aide.

Bonne journée

Re

Joli fichier !!

Essayez ce code à la place de l'autre

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fr As Worksheet
Dim Col As Integer, DerLg As Integer, i As Integer

Set fr = Sheets("Produits")

If Not Intersect(Target, Range("E:E")) Is Nothing Then

    If Target.Value = "Reçu" Then

        With fr
        'Dernière ligne de la feuille
        DerLg = .Range("A" & .Rows.Count).End(xlUp).Row
        'Dernière colonne de la feuille
        On Error Resume Next
        Col = WorksheetFunction.Match(Range("C" & Target.Row), .Rows("2:2"), 0)
        If Err = 0 Then
            'Recherche correspondance avec la référence de commande et la date de commande
            If Target.Offset(, -2) = .Cells(2, Col) Then .Range(.Cells(2, Col), .Cells(DerLg, Col)).Interior.Color = RGB(219, 219, 219)
        End If
        On Error GoTo 0

        End With

    End If
End If
End Sub

Cordialement

Re bonjour,

C'est un fichier que je construit petit à petit surtout grâce au soutien du forum.

J'aimerai bien la partager mais je ne suis pas sûr que mon application soit bien au niveau des autres déjà proposées.

Merci pour ton aide, ton code fonctionne.

C'est ce que je voulais : si la valeur de la cible est égale à "Reçu" alors on colorie dans une couleur = RGB(219, 219, 219)

Seulement cela fonctionne que dans un sens.

Est-ce qu'on pourrait ajouter une option, par exemple un "Else", si la valeur de la cible n'est pas égale à "Reçu" alors on colorie en blanc = RGB(255, 255, 255) ?

Enfin, j'ai une erreur d'exécution '13' lorsque je crée un nouveau bon de commande.

L'erreur se produit au même endroit qu'observée ce matin :

Je n'ai aucune idée d'où vient le problème. Peut être le texte "Reçu". Auquel cas on peut l'associer à la cellule J2 de la feuille commande.

Merci encore pour ton aide Dan.

re

Ne mettez pas mettre du blanc ! Cela ne sert à rien si ce n'est que de donner du poids inutile au fichier.

Dans le code ci-dessous je supprime simplement la couleur grise.

Essayez comme ceci.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fr As Worksheet
Dim Col As Integer, DerLg As Integer, i As Integer

Set fr = Sheets("Produits")

If Not Intersect(Target, Range("E:E")) Is Nothing Then

        With fr
        'Dernière ligne de la feuille
        DerLg = .Range("A" & .Rows.Count).End(xlUp).Row

        On Error Resume Next

        Col = WorksheetFunction.Match(Range("C" & Target.Row), .Rows("2:2"), 0)

            If Err = 0 Then
                'Recherche correspondance avec la référence de commande et la date de commande
                If Target.Offset(, -2) = .Cells(2, Col) And Target.Value = "Reçu" Then
                    .Range(.Cells(2, Col), .Cells(DerLg, Col)).Interior.Color = RGB(219, 219, 219)
                Else: .Range(.Cells(2, Col), .Cells(DerLg, Col)).Interior.Color = -4142
                End If
            End If

        On Error GoTo 0

        End With
    End If
End Sub

Je regarde plus tard pour l'erreur d'exécution

Cordialement

Bonjour Dan,

Ouiii ça fonctionne exactement comme je voulais. C'est trop bien.

J'ai modifié la ligne de recherche de correspondance. J'ai ajouté une condition And, on cherche selon la référence de commande et la date de commande pour plus de sécurité.

'Recherche correspondance avec la référence de commande et la date de commande
            If Target.Offset(, -2) = .Cells(2, Col) And Target.Offset(, -4) = .Cells(3, Col) And Target.Value = "Reçu" Then

Merci pour ton aide et ton suivi Dan.

Bonne Journée