Report d'une couleur en fonction des noms et des semaines

Bonjour à tous,

J'ai une fonction dans" this workbook "qui me permettait de reporter la couleur d'un planning annuel pour un utilisateur.

Sur la semaine correspondante

Suite à quelques changement sur les feuilles des semaines je n'arrive plus à la faire fonctionner

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Cel As Range, Kase As Range
Dim ColDep As Integer, ColFin As Integer
Dim j As Long, Ligne As Long

  If UCase(Left(Sh.Name, 1)) = "S" Then
    Application.ScreenUpdating = False
    With Sheets("Congés et HotLine")
        'Variable qui recherche le semaine dans la feuille annuel
      Set Cel = .Cells.Find(What:="Sh.Name", LookIn:=xlValues, LookAt:=xlWhole)
      If Not Cel Is Nothing Then
        'Attribution de la colonne de de départ de recherche
        ColDep = Cel.Column
        'Attribution de la ligne de départ de recherche
        Ligne = Cel.Row + 2
        'Boucle sur les lignes de la feuille annuel
        For j = Ligne To Ligne + 60
        MsgBox Ligne
          Set Cel = Sh.Cells.Find(What:=.Range("B" & j), LookIn:=xlValues, LookAt:=xlPart)
          If Not Cel Is Nothing Then
            Cel.Interior.ColorIndex = xlNone
          End If
        Next j
        'Boucle sur les lignes de la semaine de la feuille annuel
        For Each Kase In .Cells(Ligne, ColDep).Resize(20, 7)
          If Kase.Interior.Color = 49407 Then
          MsgBox "Youyou"
            Set Cel = Sh.Cells.Find(What:=Sh.Range("A" & Kase.Row), LookIn:=xlValues, LookAt:=xlPart)
            If Not Cel Is Nothing Then
              Cel.Interior.Color = 49407
            End If
            Exit Sub
          End If
        Next Kase
      End If
    End With
  End If

End Sub

Si vous pouviez m'aider .

Bonjour,

Pourrais tu joindre ton fichier ?

merci !!