Copier suivant critères

bonjour,

Je dispose de 3 colonnes critères dans le second onglet, je souhaiterais les noter en feuil1, si ils sont contenu dans la colonne 1.

Si il devait y avoir plusieurs critères à reporter dans une colonne , il faudrait les reporter avec un "; " en séparateur.

en espérant être clair.

cdt

Bonjour,

Le fichier:

***********************************************************************

Passage par des fonctions personnalisées en VBA,

Les formules utilisées:

Formule à saisir dans cellule B2 de la feuille1:

=Crit_1(Tableau1[[#Cette ligne];[Colonne1]];Critere1)

***********************************************************************

Formule à saisir dans cellule C2 de la feuille1:

=Crit_2(Tableau1[[#Cette ligne];[Colonne1]];Critere2)

***********************************************************************

Formule à saisir dans cellule D2 de la feuille1:

=crit_3(Tableau1[[#Cette ligne];[Colonne1]];Critere3)

***********************************************************************

le code utilisé pour chaque fonction:

Function Crit_1(Plage1 As Range, Plage2 As Range) As String
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("critères")

    Critere_1 = Split(Plage1, ";")
    For i = 1 To UBound(Critere_1)
        If Not IsError(Application.Match(Critere_1(i), Plage2, 0)) Then Liste_1 = Liste_1 & ";" & Critere_1(i)
    Next
    If Liste_1 <> "" Then
        Crit_1 = Right(Liste_1, Len(Liste_1) - 1)
    Else
        Crit_1 = ""
    End If
End Function

Function Crit_2(Plage1 As Range, Plage2 As Range) As String
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("critères")

    Critere_2 = Split(Plage1, ";")
    For i = 1 To UBound(Critere_2)
        If Not IsError(Application.Match(Critere_2(i), Plage2, 0)) Then Liste_2 = Liste_2 & ";" & Critere_2(i)
    Next
    If Liste_2 <> "" Then
        Crit_2 = Right(Liste_2, Len(Liste_2) - 1)
    Else
        Crit_2 = ""
    End If
End Function

Function Crit_3(Plage1 As Range, Plage2 As Range) As String
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("critères")

    Critere_3 = Split(Plage1, ";")
    For i = 1 To UBound(Critere_3)
        If Not IsError(Application.Match(Critere_3(i), Plage2, 0)) Then Liste_3 = Liste_3 & ";" & Critere_3(i)
    Next
    If Liste_3 <> "" Then
        Crit_3 = Right(Liste_3, Len(Liste_3) - 1)
    Else
        Crit_3 = ""
    End If
End Function

Cdlt

Bonjour

Bonjour à tous

Une variante.

Bye !

Les 2 méthodes fonctionnent très bien ,un grand merci à vous 2.