Copier coller ligne et les X suivantes dans une autre feuille

Sub demander_motclé()
Dim mot1 As String
mot1 = "Passion" 'prévioir peut ^tre  validation de données dans feuille avec les rubriques
Call detailler(mot1)
End Sub
'------
Sub detailler(mot1)
Dim Ligdeb As Byte, Ligfin As Byte
Dim T_mot

Application.ScreenUpdating = False 'fige l'écran
With ActiveSheet
    'ligne où se trouve "passion"
    Ligdeb = .Columns("A").Find(mot1, .Range("A1"), xlValues).Row
    'ligne avant nouveau mot clé
    Ligfin = .Columns("A").Find("*", .Range("A" & Ligdeb), xlValues).Row - 1
    'mémorise les détails de la "passion"
    T_mot = .Range(.Cells(Ligdeb, "A"), .Cells(Ligfin, "F"))
End With

Sheets.Add
 With ActiveSheet
    .Name = "sortie" '??? mot1 peut-^tre plus parlant si autre rubrique
    'restitue les détails
    .Range("A1").Resize(UBound(T_mot), 6) = T_mot
End With
End Sub

Sub Macro1()

'Recherche et copie des donnees voulues


Dim mot1    As String
Dim mot2    As String
Dim mot6    As String

Sheets.Add
ActiveSheet.Name = "rapport_customisé"

Dim entree As Worksheet

Dim cellule As Range

Dim ligne  As Range

Dim sortie  As Range
 
mot1 = "prenom"
mot2 = "Enfants"
mot6 = "passions"

Set entree = Worksheets(2)

Set sortie = Worksheets(1).Range("A1")

For Each ligne In entree.UsedRange.Rows

    For Each cellule In ligne.Cells

         If InStr(cellule.Text, mot1) > 0 Then

             '// On a trouvé le mot dans une cellule de la ligne

             ligne.Copy Destination:=sortie

             Set sortie = sortie.Offset(1)

             '// Pas la peine de continuer à chercher dans cette ligne

             Exit For

         End If

     Next

 Next
 
 For Each ligne In entree.UsedRange.Rows

    For Each cellule In ligne.Cells

         If InStr(cellule.Text, mot2) > 0 Then

             '// On a trouvé le mot dans une cellule de la ligne

             ligne.Copy Destination:=sortie

             Set sortie = sortie.Offset(1)

             '// Pas la peine de continuer à chercher dans cette ligne

             Exit For

         End If

     Next

 Next
 
  For Each ligne In entree.UsedRange.Rows

    For Each cellule In ligne.Cells

         If InStr(cellule.Text, mot6) > 0 Then

             '// On a trouvé le mot dans une cellule de la ligne

             Call detailler(mot6)
             
             Set sortie = sortie.Offset(1)
             
             '// Pas la peine de continuer à chercher dans cette ligne

             Exit For

         End If

     Next

 Next
 
'Mise en forme

ActiveSheet.Columns("A:B").EntireColumn.AutoFit

End Sub

'------
Sub detailler(mot6)
Dim Ligdeb As Byte, Ligfin As Byte
Dim T_mot

Application.ScreenUpdating = False 'fige l'écran
With Worksheets(2)
    'ligne où se trouve "passion"
    Ligdeb = .Columns("A").Find(mot6, .Range("A1"), xlValues).Row
    'ligne avant nouveau mot clé
    Ligfin = .Columns("A").Find("*", .Range("A" & Ligdeb), xlValues).Row - 1
    'mémorise les détails de la "passion"
    T_mot = .Range(.Cells(Ligdeb, "A"), .Cells(Ligfin, "J"))
End With


    Worksheets(1).Range("A10").Resize(UBound(T_mot), 10) = T_mot

End Sub

Worksheets(1).Range("A10").Resize(UBound(T_mot), 10) = T_mot