Sub test()
Dim i&, dl&, a&, x&, dc&
With Sheet1
dl = Sheet1.Range("A65489").End(xlUp).Row
dc = Sheet1.Range("A3").End(xlToRight).Column
For i = 4 To dl
For a = 3 To dc
If .Cells(i, a).Interior.ColorIndex = 6 And .Cells(i, a) <> "" Then x = x + 1
Next a
If x <> 0 Then .Cells(i, dc + 2) = (x * 100) / sommecouleur(Sheet1.Range(Cells(i, 3), Cells(i, dc)), Sheet3.Range("A14")) Else .Cells(i, dc + 2) = 0
x = 0
Next i
End With
Sheet3.Range("F20").Value = Application.WorksheetFunction.Average(Sheet1.Range(Cells(4, dc + 2), Cells(dl, dc + 2)))
End Sub