Copier résultat de recherche dans Feuil2

Bonjour,

Je souhaite à partir d'un fichier Excel, lancer une recherche sur un mot ou une liste de mot et copier l'intégralité de la ligne contenant le résultat dans un second onglet.

J'arrive à rechercher sur un mot et le copier dans un autre onglet mais la recherche ne s'arrète au premier résultat. Elle ne s'effectue pas sur la totalité du fichier.

Je sais qu'Il manque une boucle mais je n'arrive pas à la mettre en place.

Pour faire bien, faudrait éviter les doublons dans l'onglet 2.

Si quelqu'un peut m'aider,

Voici mon code :

Sub rechmot()
'
' rechmot Macro
' Macro enregistrée le 25/03/2008 par Guy DOUKHAN
'
Dim Var As String
Dim Rw As Range
Dim NumLig  As Long

' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)

Sheets("Feuil1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select

On Error Resume Next
Var = InputBox("Mot à rechercher ?", , "sareva")

'pour ne rien supprimer en cas d' ECHAP ou D'ANNULER
If Var = "" Then Exit Sub
Set MotTrouvé = Cells.Find(What:=Var)
If Not MotTrouvé Is Nothing Then
MotTrouvé.Select

'confirmation de recopie
Style = vbYesNo + vbDefaultButton1
Msg = "Recopie de la ligne"
Title = "Voulez-vous copier la ligne."
Réponse = MsgBox(Msg, Style, Title)
If Réponse = vbYes Then
ActiveCell.EntireRow.Select
Selection.Copy 'Shift:=xlUp

' sélection de la feuille (ou onglet) qui nous concerne
Sheets("Feuil2").Select
NumLig = 1

If Sheets("feuil2").Cells(NumLig, 1).Insert Then

' activation de la cellule A1 pour éviter un message d'incohérence de zone
Range("A1").Select
ActiveSheet.Insert
Else
NumLig = NumLig + 1
Sheets("feuil2").Cells(NumLig, 1).Paste Shift:=xlDown
            'ici pour insérer ou  .Paste pour coller'

End If
Else
MsgBox "Rien trouvé"
Exit Sub
End If
[A1].Select
End If
End Sub

Édition par Mytå, pour ajout des balises CODE

Merci de votre aide.

Je comprends à pêine ce que j'ai fais alors soyez pas trop technique dans votre réponse, merci !!!

Salut le forum

Archie66

Tu n'as qu'à cliquer sur ce lien : Joindre un fichier pour que l'on puisse t'aider, et recopier l'adresse sur ta ficelle.

Au plaisir de te relire

Mytå

Bonjour Mytå,

MErci de te pencher sur mon cas.

Alors si j'ai bien compris, voici le fichier en question, mais celui-ci n'est qu'une base pour tester la macro.

De plus, la macro se trouve dans PERSO.XLS et je ne sais pas si elle apparaît dans le fichier joint ci-dessous :

https://www.excel-pratique.com/~files/doc/guy.xls

Ca fait beaucoup d'inconnues malheureusement j'ai déjà le sentiment d'avoir bien avancé.

Donc, si on lance la macro rechmot() , elle recherche un mot désiré dans Feuil1 et recopie les lignes de résultat dans Feuil2.

Les mots à rechercher sont en majuscules.

Merci encore.

Édition par Mytå, pour correction des balises URL

bonjour,

ton lien ne marche pas, recommence "joindre un fichier"

Claude.

Salut le forum

Un début de solution avec la fonction Find

Sub rechmot()
'
' rechmot Macro
' Macro enregistrée le 25/03/2008 par Guy DOUKHAN
'
Dim Var As String
Dim Rw As Range
Dim NumLig As Long

' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)

Sheets("Feuil1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select

On Error Resume Next
Var = InputBox("Mot à rechercher ?", , "sareva")

'pour ne rien supprimer en cas d' ECHAP ou D'ANNULER
If Var = "" Then Exit Sub

With Selection
    Set c = .Find(Var, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            MsgBox c.Address

            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

End Sub

Mytå

Bonjour Mytå,

Voici à nouveau le lien mais je répète le fichier sert juste à comprendre comment réagit la macro.

https://www.excel-pratique.com/~files/doc/kaz3lguy.xls

Merci pour ton début de solution, je teste de suite.