Lié couleurs cellules aléatoire entre de multiples pages

Bonjour à tous,

Je reviens encore une fois vers vous pour avoir un peu d'aide. Je cherche une fonction qui puisse me permettre de lier des cellules au niveau des valeur et des couleur entre plusieurs feuilles.

J'ai plusieurs plages de cellules de couleurs sur une première feuille qui correspondent à une personne et une semaine

J'ai plusieurs feuilles qui correspondent aux semaines avec la même liste de personnes.

J'aimerai que la personne qui à la couleur jaune/ocre dans son planning sur la première feuille

Soit en couleur automatiquement dans la feuille de la semaine correspondante

Bonjour

Sans fichier cela va être dur, mais espère, prie, jeûne, danse etc .... peut être une solution va arriver

Amicalement

Merci de prendre le temps, désolé mon fichier est un peu brouillon.

Bonjour

A tester

Merci beaucoup excellent c'est tout à fait ça, cela correspond parfaitement avec ce que je souhaite.

Je n'ai pas bien compris comment fonctionne la ligne suivante

J'ai vue sur le net que Ucase permet de mettre en majuscule (upper case)

Si je traduit

"Si dans le nom des feuilles la première lettre à gauche est un S majuscule"

Mais dans les feuilles c'est un s minuscule est ça fonctionne .

If UCase(Left(Sh.Name, 1)) = "S" Then

Bonjour

doggerip a écrit :

Si je traduit

"Si dans le nom des feuilles la première lettre à gauche est un S majuscule"

Ce n'est pas tout à fait ça

    If UCase(Left(Sh.Name, 1)) = "S" Then

Traduction

Si la 1ère lettre en majuscule est égale à "S" alors ......

Merci d'avoir pris le temps de me répondre

J'ai essayé de commenter le code que tu m'as fourni pour le comprendre, pourrais-tu me dire si les commentaires sont correctes .

Je me demande aussi comment fait il pour changer de feuille ?

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
  ' Si la Feuille commence par un S
  If LCase(Left(Sh.Name, 1)) = "S" Then
  ' Stop la mise à jour en temp reel de l'affichage
    Application.ScreenUpdating = False
    ' L'utilisation de la feuille ("Congés et HotLine 2015") sera raccourci par un .
    With Sheets("Congés et HotLine 2015")
    ' Attribution à la variable Cel à une recherche sur le mot "semaine" ainsi que le caractère après l'éspace dans les semaine (ici le chiffre)
      Set Cel = .Cells.Find(what:="Semaine " & Mid(Sh.Name, 2), LookIn:=xlValues, lookat:=xlWhole)
    'Test si la variable Cel renvoi quelque chose
      If Not Cel Is Nothing Then
    'Si oui attribution de la première colonne à la variable ColDep
        ColDep = Cel.Column
        ' Décalage de deux ligne vers le bas par rapport à la ligne de la semaine
        Ligne = Cel.Row + 2
        'Boucle sur les lignes jusqu'a la dernière
        For J = Ligne To Ligne + 19
        'Attribution de la variable Cel à une recherche sur la colonne B ainsi que la variable J qui correspond aux numéro des lignes dans la boucle
          Set Cel = Sh.Cells.Find(what:=.Range("B" & J), LookIn:=xlValues, lookat:=xlPart)
            'Test si la variable Cel renvoi quelque chose
          If Not Cel Is Nothing Then
          'Ici Attribution d'aucune couleur à la ligne (???)
            Cel.Interior.ColorIndex = xlNone
          End If
        Next J
        'Boucle Des 20 lignes sur 7 colonnes
        For Each Kase In .Cells(Ligne, ColDep).Resize(20, 7)
        'Si la couleur de la case correspond à la couleur d'astreinte
          If Kase.Interior.Color = 49407 Then
          'Alors Cel est égale au nom correspondant à la ligne trouver dans la colonne B
            Set Cel = Sh.Cells.Find(what:=.Range("B" & Kase.Row), LookIn:=xlValues, lookat:=xlPart)
            'Si la variable Cel renvoi la couleur alors ont stop
            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

Bonjour

J'espère de n'avoir pas trop marqué de bêtises

A lire

Merci beaucoup je comprend mieux maintenant.