Sub organise()
Dim Trouve As Range
Dim Pas As String, PremiereAdresse As String, Lecture As String
Dim Ligne As Long, Cible As Long
With Worksheets("Données").Range("A:A")
Set Trouve = .Find("Affluent :", Lookat:=xlPart, LookIn:=xlValues)
If Not Trouve Is Nothing Then
Ligne = Trouve.Row
PremiereAdresse = Trouve.Address
Cible = 1
Ligne = Ligne + 1
Sheets("Resultats").Range("A" & Cible) = "Pas"
Sheets("Resultats").Range("B" & Cible & ":R" & Cible).Value = Worksheets("Données").Range("A" & Ligne & ":Q" & Ligne).Value
Do
Ligne = Ligne + 1
Pas = Trim(Split(Split(Trouve, "Pas=")(1), "t")(0))
Do
Cible = Cible + 1
Sheets("Resultats").Range("A" & Cible) = Pas
Sheets("Resultats").Range("B" & Cible & ":R" & Cible).Value = Worksheets("Données").Range("A" & Ligne & ":Q" & Ligne).Value
Ligne = Ligne + 1
Lecture = Worksheets("Données").Range("A" & Ligne)
Loop Until Lecture = ""
Ligne = Ligne + 1
Set Trouve = .FindNext(Trouve)
Ligne = Ligne + 1
Loop While Not Trouve Is Nothing And Trouve.Address <> PremiereAdresse
End If
End With
End Sub