Re,
A tester
Les résultats sont sur la feuille 1 (à modifier dans la macro pour une autre feuille)
La macro se lance depuis le bouton en feuille PRONO (Le tien)
Sub test()
Dim F1 As Range, F2 As Range
Dim i%, Dl%, Dl1%
Dl = 2
Set F1 = Sheets("PRONO").Range("B1:B2000") 'Initialise la feuille PRONO
Set F2 = Sheets("Feuil1").Range("A2:A" & Dl) 'Initialise la feuille destination (à modifier)
Sheets("Feuil1").Range("a3:j2000").ClearContents 'Efface les valeurs feuill1
For i = 1 To F1.Rows.Count 'boucle sur la colonne B feuille PRONO
If F1(i, 1).Value = "N°" Then 'condition si trouve la valeur N°
F2(Dl, 1).Value = Left(F1(i - 1, 1).Value, 5) 'Récupère les 5 premiers caractères (courses)
F1(i, 1).Select
Dl1 = Range(Selection, Selection.End(xlDown)).Count - 1 'Compte le Nb de ligne jusqu'à prochaine ligne vide
F2(Dl, 2).Value = Dl1 ' Cela donne le NB de Chevaux en course
If Dl1 > 1 Then 'Condition reprenant tes formules de petite valeur de ton onglet selection
F2(Dl, 3).Value = Application.WorksheetFunction.Small(Range(F1(i + 1, 4), F1(i + Dl1, 4)), 4)
End If
F2(Dl, 4).Value = Application.WorksheetFunction.Index(Range(F1(i + 1, 1), F1(i + Dl1, 1)), Application.WorksheetFunction.Match(F2(Dl, 3).Value, Range(F1(i + 1, 4), F1(i + Dl1, 4)), 0))
If Dl1 > 1 Then
F2(Dl, 5).Value = Application.WorksheetFunction.Small(Range(F1(i + 1, 4), F1(i + Dl1, 4)), 3)
End If
F2(Dl, 6).Value = Application.WorksheetFunction.Index(Range(F1(i + 1, 1), F1(i + Dl1, 1)), Application.WorksheetFunction.Match(F2(Dl, 5).Value, Range(F1(i + 1, 4), F1(i + Dl1, 4)), 0))
If Dl1 > 1 Then
F2(Dl, 7).Value = Application.WorksheetFunction.Small(Range(F1(i + 1, 4), F1(i + Dl1, 4)), 2)
End If
F2(Dl, 8).Value = Application.WorksheetFunction.Index(Range(F1(i + 1, 1), F1(i + Dl1, 1)), Application.WorksheetFunction.Match(F2(Dl, 7).Value, Range(F1(i + 1, 4), F1(i + Dl1, 4)), 0))
If Dl1 > 1 Then
F2(Dl, 9).Value = Application.WorksheetFunction.Small(Range(F1(i + 1, 4), F1(i + Dl1, 4)), 1)
End If
F2(Dl, 10).Value = Application.WorksheetFunction.Index(Range(F1(i + 1, 1), F1(i + Dl1, 1)), Application.WorksheetFunction.Match(F2(Dl, 9).Value, Range(F1(i + 1, 4), F1(i + Dl1, 4)), 0))
Dl = Dl + 1
End If
Next i
F1(1, 1).Select
End Sub
essai Classeur1.xlsm (810,4 Ko)