Autres Formule

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