Recherche valeur de cellule

[weissbeno]

Bonjour,
Je souhaite filtrer les infos dans un tableau bien fourni et copier les lignes qui m'interesse sur une autre feuille.

Explication :
J'entre le nom d'une personne dans la "Textbox14" et je recherche la cellule qui contient ce nom, si c'est le cas je copie la ligne entière.
Le soucis c'est que parfois la celulle contient 2 ou 3 nom séparé par des "/" et donc lorsque c'est le cas il ne me trouve pas la celulle.
Que dois je modifier dans mon code?

merci de votre aide

Voici le code que j'utilise :

Private Sub Valid14_Click()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("Feuil1").Activate ' feuille de destination

Col = "H" ' colonne de la donnée non vide à tester
NumLig = 0
With Sheets("2008") ' feuille source
NbrLig = .Cells(6500, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value = TextBox14.Value Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste
End If
Next
End With

End Sub

 

[Gorfael]

Re : Recherche valeur de cellule

Salut weissbeno et le forum
Utiliseles balises de code (#), ça rend le code plus lisible

Private Sub Valid14_Click()
 
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
 
Sheets("Feuil1").Activate ' feuille de destination
 
Col = "H" ' colonne de la donnée non vide à tester
NumLig = 0
With Sheets("2008") ' feuille source
    NbrLig = .Cells(6500, Col).End(xlUp).Row
    For Lig = 1 To NbrLig
        If .Cells(Lig, Col) like "*" & TextBox14 & "*" Then
            .Cells(Lig, Col).EntireRow.Copy
            NumLig = NumLig + 1
            Cells(NumLig, 1).Select
            ActiveSheet.Paste
        End If
    Next
End With
 
End Sub

Deux remarques sur ton code : je ne l'ai pas testé.
Il serait plus judicieux d'utiliser
sheets("source").range("source").copy sheets("destination").range("destination").
ce qui donne

        If .Cells(Lig, Col) like "*" & TextBox14 & "*" Then
            NumLig = NumLig + 1
            .Rows(Lig).Copy Rows(NumLig)
        End If

 

[weissbeno]

Re : Recherche valeur de cellule

Merci de ton aide