Recherche

Voila je souhaite afficher un bouton de recherche dans la feuille calcule recherche qui me permet rechercher par nom , prénom mail, adresse, n°telephonne et qui me donne le resultat svp

dans la rubrique école

Adresse école

la colonne rev

NOM Prenom M@il N° téléphone

et la colonne animateur

NOM Prénom M@il N°téléphone

Bon, on dit bonjour quand même ...

Pas de bouton,

Il suffit de mettre en ligne 3 un ou plusieurs critères pour que la liste s'affiche à partir de la ligne 6

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A3:K3")) Is Nothing Then Exit Sub
    If Application.CountA(Range("A3:K3")) = 0 Then
        Range("A5").CurrentRegion.Offset(1, 0).Clear
    Else
        Sheets("Pole 5").ListObjects(1).Range.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("A2:K3"), CopyToRange:=Range("A5").CurrentRegion.Resize(1), Unique:=False
    End If
End Sub

Une amélioration ... elle prend en compte une évolution de la base de données lors du retour sur l'onglet recherche

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A3:K3")) Is Nothing Then Exit Sub
    filtrer
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    filtrer
End Sub
Private Sub filtrer()
    If Application.CountA(Range("A3:K3")) = 0 Then
        Range("A5").CurrentRegion.Offset(1, 0).Clear
    Else
        Range("A5").CurrentRegion.Offset(1, 0).Clear
        Sheets("Pole 5").ListObjects(1).Range.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("A2:K3"), CopyToRange:=Range("A5").CurrentRegion.Resize(1), Unique:=False
    End If
End Sub

bonjour merci pour la proposition

je viens de tester j'ai remplis le nom prénom sur une adresse quand je fais recherche il m'affiche rien

c'est bon ca marche tres bien je vais le tester sur une grande base

Parfait !

excuse moi je viens de faire sur un autre fichier j'ai copier le code comme tu la fais sur le premier fichier mais ça me fais erreur sur ligne 9

ca viens d'ou exactement j'ai changer dans le code pole 5 par pole 4 pareille

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("A3:K3")) Is Nothing Then Exit Sub

If Application.CountA(Range("A3:K3")) = 0 Then

Range("A5").CurrentRegion.Offset(1, 0).Clear

Else

Sheets("Pole 5").ListObjects(1).Range.AdvancedFilter Action:=xlFilterCopy, _

CriteriaRange:=Range("A2:K3"), CopyToRange:=Range("A5").CurrentRegion.Resize(1), Unique:=False

End If

End Sub

je vous remercie par avance

Pole_X est en tableau.

Et pour cela, afin d'éviter des noms de colonne identiques, j'ai changé quelques intitulés

NOM_R, Prenom_R, M@il_R, N° téléphone_R, NOM_A, Prénom_A, M@il_A, N°téléphone_A

et ensuite je suis passé en tableau de données

bonjour Steelson

j'ai le fichier global actuellement est il possible de mettre ajour les classeurs pole1 pole 2 pole 3 pole 5

par exemple quand l'utilisateur remplis dans le classeur Contacts et qu'il indique dans la colonne pole 1 ou 2 ou 4 ou 5 alors cette ligne se rajoute dans les classeurs qui correspond .

et j'arrive pas encore a mettre le truc recherche pour le classeur contact malgré mes changements que tu ma expliqué

je vous remercie

Ce code permettra d'extraire de l'onglet Contacts les lignes dont le pole est indiqué en A2 sur chaque feuille.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Left(Sh.Name, 4) <> "Pole" Then Exit Sub
    Sh.Range("A6:X6").Offset(1, 0).Clear
    Sheets("Contacts").ListObjects(1).Range.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sh.Range("A1:A2"), CopyToRange:=Sh.Range("A6:X6"), Unique:=False
End Sub

bonsoir

j'ai testé le fichier c'est super ça va aidé beaucoup

merci

Parfait !

Rechercher des sujets similaires à "recherche"