A
Sub Essai()
Dim plg As Range, cel As Range, nlm&
Dim col As Byte, k As Byte, dlg&, lig&, vx%
nlm = Rows.Count: Application.ScreenUpdating = 0
For col = 25 To 40 Step 5
dlg = Cells(nlm, col).End(3).Row
If dlg > 8 Then
Set plg = Cells(9, col).Resize(dlg - 8)
vx = WorksheetFunction.Max(plg)
Set cel = plg.Find(vx, , -4163, 1, 1)
k = col - 3
Cells(1, k) = Cells(cel.Row, k)
End If
Next col
End Sub