Excel copier lignes après recherche

Option Explicit

Sub Traitement()

    Dim Plage As Range, Cible As Range, Ligne As Long
    Dim Feuille As Worksheet, Resultat As Worksheet
    
    ' Ne pas effectuer l'affichage pendant la macro
    ' Ceci permet de minimiser le temps d'exécution
    ' Enlever le commentaire
    'Application.ScreenUpdating = False
    
    ' Définition de la plage de recherche
    Set Plage = ActiveSheet.UsedRange
    Set Feuille = ActiveSheet
    
    ' Ajout d'une nouvelle feuille recevant les copies
    ActiveWorkbook.Sheets.Add.Name = "Resultat"
    Set Resultat = ActiveSheet
    
    ' Balayage de la plage de données
    Feuille.Activate
    For Each Cible In Plage
        ' Validation du mot clé recherché
        If (Cible.Value = "Mot_Recherché") Then
            ' Sélection de la ligne
            Cible.EntireRow.Select
            ' Lance la copie
            Selection.Copy
            ' Changement de feuille
            Resultat.Activate
            ' Déterminer à quel ligne copier le résultat
            Ligne = (Range("A1:A65536").End(xlDown).Row + 1)
            ' Sélection de l'emplacement pour copier
            Range("A" & Ligne).Select
            ' Copie
            ActiveSheet.Paste
            ' Désactivation du mode copier/coller
            Application.CutCopyMode = False
            ' Retour à la feuille de recherche
            Feuille.Activate
        End If
    Next Cible
    
    ' Réactiver l'affichage
    ' Enlever le commentaire si enlever en haut
    'Application.ScreenUpdating = True
    
End Sub
'