Macro excel pour tri de données et récupération d'information en tête de ligne

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