Sub ValeurCible()
Dim i&
Application.ScreenUpdating = False
i = 10
[H:H].ClearContents 'RAZ
Range("I34:M" & Rows.Count).ClearContents 'RAZ
While Cells(i, 1) <> ""
Cells(i + 23, "I").GoalSeek Goal:=7500, ChangingCell:=Cells(i + 23, "H")
If Cells(i + 23, "H") < 0 Then Cells(i + 23, "H") = Application.Max(Cells(i, "F").Resize(23))
i = i + 24
If Cells(i, 1) <> "" Then Cells(i - 24, 9).Resize(24, 5).Copy Cells(i, "I")
Wend
End Sub