[XL-2007] recherche de chaîne de caractères identiques

[monk83]

Bonjour,
(je suis un autodidacte avec quelques années de vol alors soyez indulgents )
malgré mes recherches je n'arrive pas à trouver la formule qui permet de rechercher une chaîne de caractères identiques dans les cellules d'une colonne et de recopier les lignes concernées.
Comme c'est un peu difficile à expliquer j'ai mi un tableau en PJ avec mon objectif.
Au cas où ?

Merci

[mercatog]

Bonjour
Code commenté à mettre dans le module de ta feuille (évènement change appelé à chaque changement de la cellule H3

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastLig As Long
Dim Plage As Range
 
'Desactive la mise à jour affichage
Application.ScreenUpdating = False
'si la cellule changée est H3
If Target.Address = "$H$3" Then
'On efface la région résultat
    Range("F5").CurrentRegion.Clear
    'si H3 n'est pas vide
    If Target.Value <> "" Then
        'On supprime l'éventuel filtre automatique de la feuille
        AutoFilterMode = False
        'N° ligne de la dernière cellule remplie de la colonne A
        LastLig = Cells(Rows.Count, "A").End(xlUp).Row
        'Dans plage on a la plage des données
        Set Plage = Range("A3:D" & LastLig)
        'On filtre notre plage sur la colonne C avec comme valeur du filtre la valeur entrée en H3*
        Plage.AutoFilter Field:=3, Criteria1:=Target.Value & "*"
        'on désactive l'appel des évènements
        Application.EnableEvents = False
        'on copie le résultat du filtre en F5
        Plage.SpecialCells(xlCellTypeVisible).Copy Range("F5")
        'on réactive l'appel des évènements
        Application.EnableEvents = True
        'on libère la variable objet Plage
        Set Plage = Nothing
        'on supprime le filtre automatique crée
        AutoFilterMode = False
    End If
End If
End Sub

[monk83]

Merci pour cette réponse rapide et pédagogique
Je vais essayer de comprendre tout ça pour le mettre en application car il est important de réfléchir pour progresser mais je me permettrai peut-être de demander une aide complémentaire...
C'est très sympathique, bon week-end