Private Sub CommandButton1_Click()
Dim s As Shape, lig&, col%, at$, sp, c As Range, flag As Boolean, r As Range, n%
Application.ScreenUpdating = False
[E:G].Clear
For Each s In Shapes
lig = s.TopLeftCell.Row
col = s.TopLeftCell.Column
at = s.AlternativeText
sp = Split(at, "_")
If at Like "hippodrome*" Then
Cells(lig + 2, 5).Resize(, 3).Interior.Color = 13434828
ElseIf UBound(sp) > 0 Then
If col = 2 Then Cells(lig, 7) = sp(1)
If col = 3 Then Cells(lig, 6) = sp(1)
If col = 4 Then Cells(lig, 5) = sp(1)
Cells(lig, 5).Resize(2, 3).Interior.Color = 10079487
End If
Next s
With Sheets("PRONOS TRIO")
For Each c In .UsedRange
If c = "CHX" Then c(1, 2).Resize(, 6) = "" 'RAZ
Next c
For Each c In Intersect([E:G], Me.UsedRange.EntireRow)
If c.Interior.ColorIndex = xlNone Then flag = False
If Not flag And c.Interior.Color = 13434828 Then
flag = True
sp = Split(c(-2, -2), "C") 'références de la course
Set r = Nothing
n = 0
If UBound(sp) > 0 Then
Set r = .Cells.Find(sp(0), , xlValues, xlWhole)
If Not r Is Nothing Then Set r = r.EntireColumn.Find("Course " & sp(1))
If Not r Is Nothing Then Set r = r(2, 2).Resize(, 6)
End If
ElseIf flag And Not r Is Nothing And IsNumeric(CStr(c)) Then
n = n + 1
If n < 7 Then r(n) = c
End If
Next c
[E:G].Delete
.Activate
End With
End Sub