Si colonne > autre colonne, ne pas afficher

Bonjour,

La macro ci-dessous me sert à afficher des données en fonctions de deux critères (B1/B2) de la feuille "Needed Kit's Component":

Option Explicit
Dim tblo(), i As Long, xlgn As Long, xlgndata As Long, xresultat As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("$B$2")) Is Nothing Then
        xlgn = Range("A65536").End(xlUp).Row + 1
        Range("A4:J" & xlgn).ClearContents
        ' Transfert données dans le tableau
        xlgndata = Sheets("DATA").Range("A65536").End(xlUp).Row
        ReDim tblo(xlgn, 48)
        tblo() = Sheets("DATA").Range("A2:AV" & xlgndata).Value
        ' affectation des variables pour la recherche
        xresultat = False
        xlgn = Sheets("Needed Kit's Component").Range("A65536").End(xlUp).Row
            For i = LBound(tblo, 1) To UBound(tblo, 1)
                If tblo(i, 23) = Cells(2, 2).Value And tblo(i, 48) = Cells(1, 2).Value Then
                    xresultat = True: xlgn = xlgn + 1
                        With Sheets("Needed Kit's Component")
                            .Range("A" & xlgn) = tblo(i, 3)
                            .Range("B" & xlgn) = tblo(i, 4)
                            .Range("C" & xlgn) = tblo(i, 5)
                            .Range("D" & xlgn) = tblo(i, 6)
                            .Range("E" & xlgn) = tblo(i, 10)
                            .Range("F" & xlgn) = tblo(i, 1)
                            .Range("G" & xlgn) = tblo(i, 19)
                            .Range("H" & xlgn) = tblo(i, 20)
                            .Range("I" & xlgn) = tblo(i, 21)
                            .Range("J" & xlgn) = tblo(i, 22)
                        End With
                End If
            Next i
        If xresultat = False Then MsgBox "Aucune donnée pour cette sélection de paramètres."
        Erase tblo
    End If
End Sub

Serait-il possible que si dans, dans la feuille source "DATA", par exemple P2 (stock) est supérieur à G2 (quantité rupture), ça ne reporte pas cette ligne dans la feuille "Needed Kit's Component".

En vous remerciant d'avance.

Cordialement,

Max

Bonjour,

Ajoute les données surlignées à ton code.

Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("$B$2")) Is Nothing Then
        xlgn = Range("A65536").End(xlUp).Row + 1
        Range("A4:J" & xlgn).ClearContents
        ' Transfert données dans le tableau
        xlgndata = Sheets("DATA").Range("A65536").End(xlUp).Row
        ReDim tblo(xlgn, 48)
        tblo() = Sheets("DATA").Range("A2:AV" & xlgndata).Value
        ' affectation des variables pour la recherche
        xresultat = False
        xlgn = Sheets("Needed Kit's Component").Range("A65536").End(xlUp).Row
        For i = LBound(tblo, 1) To UBound(tblo, 1)
           If tblo(i, 7) > tblo(i, 16) Then
                If tblo(i, 23) = Cells(2, 2).Value And tblo(i, 48) = Cells(1, 2).Value Then
                    xresultat = True: xlgn = xlgn + 1
                    With Sheets("Needed Kit's Component")
                        .Range("A" & xlgn) = tblo(i, 3)
                        .Range("B" & xlgn) = tblo(i, 4)
                        .Range("C" & xlgn) = tblo(i, 5)
                        .Range("D" & xlgn) = tblo(i, 6)
                        .Range("E" & xlgn) = tblo(i, 10)
                        .Range("F" & xlgn) = tblo(i, 17)
                        .Range("G" & xlgn) = tblo(i, 19)
                        .Range("H" & xlgn) = tblo(i, 20)
                        .Range("I" & xlgn) = tblo(i, 21)
                        .Range("J" & xlgn) = tblo(i, 22)
                    End With
                End If
            End If
        Next i
        If xresultat = False Then MsgBox "Aucune donnée pour cette sélection de paramètres."
        Erase tblo
    End If
End Sub

Merci Jean-Eric,

Merci beaucoup, ça marche parfaitement, juste que j'ai remplacé le N° de colonne (17 au lieu de 16).

Bonne journée.

Max

Bonjour,

Seriez-vous en mesure d'adapter la macro ci-dessus pour le fichier en PJ.

En vous remerciant

Max