Private Sub Worksheet_Activate()
Dim txt$, Nmax&, deb As Range, c As Range, lig&, h&
txt = "non conforme" 'texte à rechercher
Nmax = 11 'nombre maximum de lignes copiées, à adapter
Application.ScreenUpdating = False
Rows(3).Resize(Rows.Count - 2).Delete 'RAZ
With Sheets("Sheet1") 'à adapter
Set deb = .Cells.Find(txt, , xlValues, xlWhole)
If deb Is Nothing Then Exit Sub
Set c = deb
lig = 3
Do
h = c.EntireRow.CurrentRegion.Rows.Count
If h > Nmax Then h = Nmax
.Rows(c.Row).Resize(h).Copy Cells(lig, 1)
Set c = .Cells.Find(txt, c)
lig = lig + h + 1 '1 ligne de séparation
Loop While c.Row > deb.Row
End With
End Sub