Optimisation de code, ça rame !

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static cel As Range
Dim n°L As Long

  If cel Is Nothing Then Set cel = ActiveCell
  If Intersect(cel, Columns("Q:Q")) Is Nothing Then
    Set cel = ActiveCell
    Exit Sub
  End If
  If cel.Interior.Color <> RGB(255, 255, 0) Then
    Columns("P:Q").Interior.Color = RGB(255, 255, 255)
    Set cel = ActiveCell
    Exit Sub
  End If
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Columns("P:Q").Interior.Color = RGB(255, 255, 255)
  For n°L = 1 To Cells(Application.Rows.Count, 3).End(xlUp).Row
    If Cells(n°L, "P").Value = cel.Offset(0, -1).Value Then
      Cells(n°L, "P").Resize(1, 2).Interior.Color = RGB(255, 255, 0)
    End If
  Next n°L
  Set cel = ActiveCell
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True

End Sub

Option Explicit

Dim x As Integer
Dim Cell As String


Sub Code()

Application.ScreenUpdating = False

Dim DL As Long
Dim i As Long
Dim j As Long

DL = ActiveSheet.Cells(Application.Rows.Count, 3).End(xlUp).Row

For i = 1 To DL
For j = 1 To DL

If ActiveSheet.Range("Q" & i).Interior.Color = RGB(255, 255, 0) Then
    If CStr(ActiveSheet.Range("P" & i).Value) = CStr(ActiveSheet.Range("P" & j).Value) Then
        ActiveSheet.Range("P" & j).Interior.Color = RGB(255, 255, 0)
        ActiveSheet.Range("Q" & j).Interior.Color = RGB(255, 255, 0)
    End If
End If

Next j

Next i

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
        x = ActiveCell.Interior.ColorIndex
        Cell = ActiveCell.Address
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    
    If Cell = "" Then
        x = Target.Interior.ColorIndex
        Cell = Target.Address
        Exit Sub
    End If
    
    If Range(Cell).Interior.ColorIndex <> x Then _
        Call Code
    
    x = Target.Interior.ColorIndex
    Cell = Target.Address
End Sub