Lier deux groupes de colonne d'une même page

Bonjour,

Je vais essayer d'être le plus clair possible (même si c'est un peu compliqué dans ma tête ...):

J'ai effectué deux tableaux (l'un à côté de l'autre) sur une page excel

Dans le premier tableau, j'ai trois colonnes (Range(C3:E145)) qui contiennent des dates et dans le second j'ai trois colonnes (Range(K6:M145)) qui contiennent des valeurs numériques associées aux dates (en clair, C6 est associée à K6, D6 associée à L6, E6 associée à M6 ...).

J'ai déjà une première partie VBA qui me permet de coloriser les cellules des 3 premières colonnes en fonction du mois (une couleurs pour chaque mois: code si dessous). J'aurais maintenant besoin de faire en sorte que si C6 est coloré, K6 prenne la même couleur, si D6 est coloré, L6 prenne la même couleur ....

Je suis complètement perdu...

Merci de votre aide.

Sub color()

    Dim Plage As Range, Cellule As Range
    Dim Position As Integer

    Set Plage = Range("C6:E145")

    For Each Cellule In Plage
    If Cellule.Value Like "*/01/*" Then
        Cellule.Interior.ColorIndex = 3
    ElseIf Cellule.Value Like "*/02/*" Then
        Cellule.Interior.ColorIndex = 4
    ElseIf Cellule.Value Like "*/03/*" Then
        Cellule.Interior.ColorIndex = 5
    ElseIf Cellule.Value Like "*/04/*" Then
        Cellule.Interior.ColorIndex = 22
    ElseIf Cellule.Value Like "*/05/*" Then
        Cellule.Interior.ColorIndex = 6
    ElseIf Cellule.Value Like "*/06/*" Then
        Cellule.Interior.ColorIndex = 7
    ElseIf Cellule.Value Like "*/07/*" Then
        Cellule.Interior.ColorIndex = 8
    ElseIf Cellule.Value Like "*/08/*" Then
        Cellule.Interior.ColorIndex = 24
    ElseIf Cellule.Value Like "*/09/*" Then
        Cellule.Interior.ColorIndex = 40
    ElseIf Cellule.Value Like "*/10/*" Then
        Cellule.Interior.ColorIndex = 46
    ElseIf Cellule.Value Like "*/11/*" Then
        Cellule.Interior.ColorIndex = 50
    ElseIf Cellule.Value Like "*/12/*" Then
        Cellule.Interior.ColorIndex = 16
    Else
       Cellule.Interior.ColorIndex = 0
    End If
Next

End Sub

personne n'a de solutions?

Bonsoir,

Sub color()
    Dim clr, c As Range, m%
    clr = Array(0, 3, 4, 5, 22, 6, 7, 8, 24, 40, 46, 50, 16)
    Application.ScreenUpdating = False
    For Each c In Range("C6:E145")
        On Error Resume Next
        m = Month(c)
        If Err.Number <> 0 Then
            m = 0: Err.Clear
        End If
        On Error GoTo 0
        c.Interior.ColorIndex = clr(m)
        c.Offset(, 8).Interior.ColorIndex = clr(m)
    Next c
End Sub

Cordialement.

Bonjour,

Merci pour ce retour, par contre, j'ai du mal à comprendre le code: a quelle moment est il fait mention du tableau (K6:M145)?

Réveille-toi...

    c.Offset(, 8)...

c'est la cellule correspondante sur le second tableau.

Cordialement.

Cool, merci, ça fonctionne.

Dernier petit soucis, dans la ligne:

clr = Array(0, 3, 4, 5, 22, 6, 7, 8, 24, 40, 46, 50, 16)

On reprend les couleurs de tous les mois, mais dans l'exécution du code, l'ensemble dses colonnes (C6:E145) et (K6:M145) prennent la couleur "16" (donc gris foncé) au lieu de rester en blanc (pour les cases vide)

Bonjour,

Je vois ! C'est que les cellules vides renvoient 0, et 0 pour VBA est le 30 décembre 1899 !

Modifie la ligne qui suit On Error Resume Next :

        m = IIf(c <> "", Month(c), 0)

Cela devrait corriger le problème.

Cordialement.

Impressionné...

Merci beaucoup