Copie & Recherche par mot clef

[Seb67210]

Bonjour à tous et à toutes,

J'aimerais savoir si quelqu'un possède un code permettant de faire la chose suivante :

1) Selectionnez une chaine de caractere à rechercher
ex: I_21
2) Rechercher dans toutes les lignes de la colonne "A" si cette chaine de caractère est présente ou pas, si oui copier la ligne sur une autre feuille.
Faire de même pour toutes les lignes du tableau.

Merci d'avance

 

[condors.s]

Re : Copie & Recherche par mot clef

Tu peux essayer ca :

Sub Copier_les_lignes_I_21()
'
' Macro6 Macro
'

'
    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Rows("1:33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    Range("A1").Select
    ActiveSheet.Range("$A$1:$F$32").AutoFilter Field:=1, Criteria1:="=*I_21*", _
        Operator:=xlAnd
    Rows("5:5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil2").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
End Sub

 

[Seb67210]

Re : Copie & Recherche par mot clef

Merci !
Peux m'expliquer un peu le fonctionnement stp ?

 

[condors.s]

Re : Copie & Recherche par mot clef

Seb67210,
Il s'agit en fait d'une macro enregistrée.

1- J'ai créé des filtre sur la ligne 1
2- J'ai demandé que n'apparaisse que les lignes dont la colonne A est égale à I_24
3- J'ai copié les ligne visible
4- Collé dans un autre onglet
5- Suprimé mes filtre


Le principal risque de cette méthode c'est d'oublier des hypothèses...
A toi de voir ce qui ne va pas pour corriger la commande

 

[Seb67210]

Re : Copie & Recherche par mot clef

Je souhaiterais faire une recherche sur A1..A500 si la chaine est présente, si oui copier dans une autre feuille toutes les lignes ou se trouvent la chaine,

Si en A25 est présente la chaine de caratère alors copier la ligne 25 et ainsi créer un nouveau table ne contenant que cette chaine de caractère

 

[condors.s]

Re : Copie & Recherche par mot clef

J'ai un peu corrigé le code pour l'adapter à ce que tu dis.

Dis moi si ca marche

Sub Copier_les_lignes_I_21()
'
' Macro6 Macro
'

'
    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Rows("1:500").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    Range("A1").Select
    ActiveSheet.Range("$A$1:$F$500").AutoFilter Field:=1, Criteria1:="=*I_21*", _
        Operator:=xlAnd
    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil2").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
End Sub

 

[Seb67210]

Re : Copie & Recherche par mot clef

Désolé mais cela ne fonctionne pas...
Si j'ai 25 fois la chaine présente cela ne copie qu'une 1 fois ou 2 j'essaye de comprendre.

Cela fonctionne chez toi?

Sinon, j'ai un code qui fait la recherche ( reste plus qu'à copier ) mais celui-ci ne fonctionne que si la chaine recherche est exactement celle dans la cellule

ex: je recherche I_21 et dans la cellule j'ai I_21_25, cela ne fonctionne pas.

Sub recherche()

Dim Str_Plage As String
Dim Cel As Range
Dim Feuil As Worksheet
Dim Str_critère As String
Dim X As Byte

Sheets("Feuil6").Select


Str_Plage = "A6:K500"
Str_critère = InputBox("Saisir le mot clef souhaité puis cliquez sur 'OK' pour lancer votre recherche...")

If Str_critère = "" Then
Exit Sub
End If

For Each Feuil In Sheets
For Each Cel In Feuil.Range(Str_Plage)
If UCase(Cel) Like UCase(Str_critère) Then

Feuil.Activate
Cel.Activate

X = MsgBox("Mot Clef """ & Str_critère & """ trouvé :" & Chr(13) & _
"Sur la feuille : " & Feuil.Name & Chr(13) & _
"A la cellule : " & Cel.Address(0, 0) & Chr(13) & Chr(13) & _
"" & Chr(13) & _
"Voulez vous arrêter la recherche ??? " & Chr(13), vbDefaultButton2 + _
vbQuestion + vbYesNo, "Mot clef trouvé ")


Select Case X
Case 6
Feuil.Activate
Cel.Activate
Exit Sub
Case 2 'annuler on sort
Exit Sub

Case Else 'Non=7
'Sheets("Baumer").Select
'on fait rien, mais on pourrait
End Select
End If
Next Cel
Next Feuil
MsgBox ("Recherche terminée !")


End Sub