Sub Xtract_AA()
Dim Boucle As Integer, Position As Integer
Dim Compteur As Integer, Fin As Integer
For Boucle = 1 To Cells(65536, 1).End(xlUp).Row Step 1
Compteur = 2
Position = 1
Do While Position < Len(Cells(Boucle, 1).Value)
Position = InStr(Position, Cells(Boucle, 1).Value, "aa")
If Position <> 0 Then
Fin = InStr(Position, Cells(Boucle, 1).Value, " ") + 1
Cells(Boucle, Compteur).Value = Mid$(Cells(Boucle, 1).Value, Position, Fin - Position - 1)
Position = Fin
Compteur = Compteur + 1
Else
Exit Do
End If
Loop
Next Boucle
End Sub