Recopier Donnee Avec La Meme Couleur De Police

[MikeBelgique]

Bonjour tout le monde, je souhaiterais un petit coup de pouce, je joint le fichier avec explication, merci de votre aide

 

[BOISGONTIER]

Re : Recopier Donnee Avec La Meme Couleur De Police

Bonjour,

Voir PJ

JB

 

[MikeBelgique]

Re : Recopier Donnee Avec La Meme Couleur De Police

Merci pour ta formule qui est plus simple que celle que j'avais mais mon réel problème se situe sur la feuille 2, désolé j'aurais du le stipuler

 

[BOISGONTIER]

Re : Recopier Donnee Avec La Meme Couleur De Police

Voir PJ

Private Sub Worksheet_Activate()
 For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
    a = Split(Mid(c.Formula, 2), "!")
    Sheets(a(0)).Range(a(1)).Copy
    c.PasteSpecial Paste:=xlPasteFormats
  Next c
End Sub

JB

 

[MikeBelgique]

Re : Recopier Donnee Avec La Meme Couleur De Police

Merci à toi Boisgontier, cela marche très bien mais peux ton limiter à recopier uniquement la couleur de police sans prendre en compte la couleur de font de cellule ni format, je sais je suis difficile et compliqué mais c'est important pour la bonne suite

 

[BOISGONTIER]

Re : Recopier Donnee Avec La Meme Couleur De Police

Private Sub Worksheet_Activate()
 For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
    a = Split(Mid(c.Formula, 2), "!")
    c.Font.ColorIndex = Sheets(a(0)).Range(a(1)).Font.ColorIndex
  Next c
End Sub

JB

 

[MikeBelgique]

Re : Recopier Donnee Avec La Meme Couleur De Police

Bonjour, désolé boisgontier de répondre si tard mais je n'ai pas eu le temps de m'occuper de tout cela. Merci à toi, mais je n'arrive pas à le faire fonctionner sur mon fichier, ligne erreur d'éxécution 9
c.Font.ColorIndex = Sheets(a(0)).Range(a(1)).Font.ColorIndex se met en jaune (a(0)).Range(a(1)) l'indice n'appartient pas à la sélection. J'ai beau chercher, tripatouiller, tester je n'arrive pas à la solution finale.

 

[MikeBelgique]

Re : Recopier Donnee Avec La Meme Couleur De Police

Oups je reviens à la charge, pour mon problème, qui peut m'aider, doit on peut etre cibler la plage de reference, du fait que sur mon fichier il existe d'autre donnees sur la page? merci à vous de m'éclairer

 

[BOISGONTIER]

Re : Recopier Donnee Avec La Meme Couleur De Police

Bonjour,

Private Sub Worksheet_Activate()
 Set champ = Range("B7:U8")
 For Each c In champ.SpecialCells(xlCellTypeFormulas, 23)
    a = Split(Mid(c.Formula, 2), "!")
    c.Font.ColorIndex = Sheets(a(0)).Range(a(1)).Font.ColorIndex
 Next c
End Sub

JB

 

[MikeBelgique]

Re : Recopier Donnee Avec La Meme Couleur De Police

Grand grand merci BOISGONTIER, pour la rapidité de ta réponse et je confirme que cela fonctionne nickel, mille merci.:

 

[MikeBelgique]

Re : Recopier Donnee Avec La Meme Couleur De Police

J'aurais souhaiter un petit plus ; le calcul du nbr de cellule écrite en noir voir fichier joint page 2

 

[BOISGONTIER]

Re : Recopier Donnee Avec La Meme Couleur De Police

Voir PJ

Function compteCouleurTexte(champ, couleur)
  Application.Volatile
  n = 0
  For Each c In champ
    If c.Font.ColorIndex = couleur Then n = n + 1
  Next c
  compteCouleurTexte = n
End Function

JB

 

[MikeBelgique]

Re : Recopier Donnee Avec La Meme Couleur De Police

ah j'avais pas fait attention au petit calculate, et je cherchais pourquoi il ne calculait pas automatiquement sur mon fichier, et voilà c parfait maintenant, comme depuis le début toujours au top, merci BOISGONTIER, trop fort!!!