Copie de couleur (non colorindex) d'une cellule à une autre

Bonjour

Je souhaiterais un peu d'aide pour copier la couleur de différentes cellules en feuille 1 vers d'autre cellules feuille 2 selon leur valeur.

pour avoir un peu chercher sur le forum, je crois que je peux ajouter que ce n'est pas des couleur de colorindex.

Je vous ajoute un fichier qui est l'extrait du fichier original, et si ce n'est pas trop demandé, pourrais-je avoir quelque commentaire dans la macro des étapes afin de comprendre.

D'avance merci pour l'aide.

Bonsoir,

Sub Couleurs()
    Dim i%
    For i = 2 To 6
        Worksheets("Feuil2").Cells(i, 2).Interior.Color = _
         Worksheets("Feuil1").Cells(i, 2).Interior.Color
    Next i
End Sub

On affecte à la propriété Color du fond des cellules cibles la valeur de la même propriété des cellules sources, rien d'autre à expliquer.

Cordialement

Bonjour MFerrand,

Merci beaucoup, un petit pas pour toi, mais un grand pas pour moi

On a toujours des choses à apprendre.

Bonne journée.

Re bonjour,

Je vais complexifier un peu ma question,

Voici à quoi ressemble le fichier original,

- sachant que sur la "feuil1", il y a maintenant environ 500 ligne avec des couleurs différente et des rajout de ligne régulièrement,

- que la 2éme feuille "22.10.2015" change de nom tous les jours et l'ordre des "Code couleur" n'est pas forcement le même que sur la "feuil1"

- La base de donnée est sur la "feuil1" et la destination sur "22.10.2015"

Mon idée est qu'en écrivant un "Code couleur" sur la colonne A de "22.10.2015",

la recherchev ajout la valeur dans la colonne H "Désignation FWI"

et qu'ensuite une macro puisse affecter à cette colonne, cellule par cellule, la bonne couleur selon la valeur reporter par la recherchev.

Merci pour le temps passé sur le sujet

Un peu compliqué, et ça va devenir long, à la longue !

Solution plus rapide : en triant les 2 feuilles sur ton code couleur, on rétablit la correspondance...

Pour ce qui est du changement de nom, si c'est bien un changement de nom et que c'est bien la même feuille toujours, utiliser son nom de code : au lieu de Worksheets("nom").... mettre Feuil2... (sans guillemets, c'est son CodeName dans ton modèle, voir ce qu'il en est dans ton fichier réel).

Cordialement.

Bonjour,

Pour ceux que ça intéresse, après un peu de recherche j'ai pu construire ceci :

- fonction pour récupérer les couleur RGB :

Function getRGB2(rcell) As String
    Dim c As Long
    Dim R As Long
    Dim G As Long
    Dim B As Long

    c = rcell.Interior.color
    R = c Mod 256
    G = c \ 256 Mod 256
    B = c \ 65536 Mod 256
    getRGB2 = "" & R & "," & G & "," & B
End Function

J'additionne ensuite le R, le G et le B pour pouvoir classer les couleur du plus foncé au plus clair.

- Ci-dessous la procédure pour aller chercher dans la base de couleur, la couleur selon la valeur de mes cellules.

Sub couleur_teinte()

'récupération des couleur de teinte

Application.ScreenUpdating = False

Set F1 = Worksheets("BD")

With F1
Set plage = .Range("X4:X25")

End With

For Z = 2 To 1000 Step 1

For Each cell In plage

cell.Select
If cell.Value = Cells(Z, 2).Value Then Selection.Interior.color = F1.Cells(Z, 2).Interior.color
If cell.Value = Cells(Z, 2).Value Then Selection.Font.color = F1.Cells(Z, 2).Font.color

Next

Next Z

Application.ScreenUpdating = True

End Sub

- Et enfin la copie de mon tableau d'origine vers une autre feuille renommé à la date du jour, tri des couleur foncé à clair.

Sub copie_tab()
'
'
'Touche de raccourci du clavier: Ctrl+t

'copie du tableau sur une nouvelle page
    Sheets("BD").Select
    Range("Q3:Z26").Select
    Selection.Copy
    Sheets.Add Before:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

' largeur_colonne
    Columns("A:J").Select
    Columns("A:J").EntireColumn.AutoFit

'renommer la feuille
    ActiveSheet.Name = Date

'auto filtrer
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort.SortFields.Add Key:= _
        Range("I1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'formule des totaux

    Range("A24").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[-22]C:R[-1]C)"
    Range("C24").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-22]C:R[-1]C)"
    Range("D24").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-22]C:R[-1]C)"
    Range("E24").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(R[-22]C:R[-1]C,""SAPA"")"

End Sub

Etant novice en VBA j'imagine que tous ceci est améliorable, donc n'hésitez pas à me corriger. Mais la ça a l'avantage de fonctionner.