Sub Afficher()
Dim WSh As Worksheet, rg As Range, Ligne As Range, Blanc As Long, Noir As Long, Vert1 As Long, Vert2 As Long, i As Long
Blanc = RGB(255, 255, 255)
Noir = RGB(0, 0, 0)
Vert1 = RGB(226, 239, 218)
Vert2 = RGB(198, 224, 180)
Set WSh = JUPILER_PRO_LEAGUE
Application.ScreenUpdating = False
'Tableau de classement
Set rg = WSh.[AM4:BE21]
For Each Ligne In rg.Rows
With Ligne
If Len(.Cells(2) & "") = 1 Then
With .Resize(1, 10)
.Borders.LineStyle = xlContinuous
.Interior.Pattern = xlNone
.Font.Color = Noir
End With
With .Cells(12).Resize(, 2)
.Borders.LineStyle = xlDot
.Borders(xlInsideVertical).LineStyle = xlNone
.Font.Color = Noir
End With
With .Cells(15).Resize(, 5)
.Borders.LineStyle = xlDot
.Font.Color = Noir
End With
End If
End With
Next Ligne
'Résultats des journées
Set rg = WSh.[D3:K376]
'Afficher les équipes non renseignées (nom = 1 lettre)
With rg.Offset(1).Resize(10)
For i = 1 To 10
If Len(.Cells(i, 3) & "") = 1 Then
With Union(.Cells(i, 1), .Cells(i, 8))
.Font.Color = Noir
.Interior.Color = Vert2
End With
With .Cells(i, 3).Resize(, 4)
.Font.Color = Noir
.Interior.Color = IIf(i Mod 2 = 0, Vert2, Vert1)
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
End If
Next i
End With
'Afficher les journées vides
Set Modèle = rg.Resize(11)
Modèle.Copy
rg.Offset(11).Resize(rg.Rows.Count - 11).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Application.Goto WSh.[A1]
Application.ScreenUpdating = True
End Sub