Bonjour Joco7915,
Merci de m'avoir signalé cette erreur. Effectivement il manquait une ligne de contrôle, voilà qui est corrigé:
Sub Recup_Score()
Dim i As Long, j As Long, k As Long, Col As Long, Tabl As Long
Dim Eq As Long, Eq_1 As Long, Eq_2 As Long, Eq_3 As Long
Application.ScreenUpdating = False
'Effacement des prédédents scores dans les tableaux de synthèse
Range("D5:E313,H5:I313,L5:M313,P5:Q3132").ClearContents
Tabl = 1
For i = 70 To 85 Step 5 'on balaye chaque tableau entre les colonnes BR et CJ
Col = i
ListeSuivante:
For j = 5 To 53 Step 3
If Col = i Then
Score_1 = Cells(j, Col + 1)
Score_2 = Cells(j, Col + 2)
If Score_1 <> "" And Score_2 <> "" Then
Eq_1 = Cells(j, Col)
Eq_2 = Cells(j + 1, Col)
Eq_3 = Cells(j + 2, Col)
End If
Else
Score_1 = Cells(j, Col - 1)
Score_2 = Cells(j, Col - 2)
If Score_1 <> "" And Score_2 <> "" Then
Eq_1 = Cells(j, Col)
Eq_2 = Cells(j + 1, Col)
Eq_3 = Cells(j + 2, Col)
End If
End If
'Recopie dans le tableau des classements
For k = 1 To 3
Select Case k
Case 1
Eq = Eq_1
Case 2
Eq = Eq_2
Case 3
Eq = Eq_3
End Select
If Score_1 <> "" And Score_2 <> "" Then '********* Ligne de contrôle suppléméntaire ******************
With Range("A1:A313")
Set x = .Find(Eq, lookat:=xlWhole)
If Not x Is Nothing Then
Select Case Tabl
Case 1
Range(Cells(x.Row, "D"), Cells(x.Row, "E")).Value = Array(Score_1, Score_2)
Case 2
Range(Cells(x.Row, "H"), Cells(x.Row, "I")).Value = Array(Score_1, Score_2)
Case 3
Range(Cells(x.Row, "L"), Cells(x.Row, "M")).Value = Array(Score_1, Score_2)
Case 4
Range(Cells(x.Row, "P"), Cells(x.Row, "Q")).Value = Array(Score_1, Score_2)
End Select
End If
End With
End If
Next k
Next j
If Col = i Then
Col = i + 3
GoTo ListeSuivante
End If
Tabl = Tabl + 1
Next i
End Sub
A tigre5:
Avec le fichier en Xlsb, ça ne marche toujours pas? Les macros sont-elles activées dans les options excel?
Sinon, patientez un peu et je vais essayer de vous le faire par formule.