Copier Coller Couleur Police et remplissage Plage Cellule Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
vaffancolor
Membre fidèle
Membre fidèle
Messages : 260
Appréciations reçues : 7
Inscrit le : 30 mars 2018
Version d'Excel : 2016 FR

Message par vaffancolor » 14 juin 2019, 15:12

Bonjour,

J'aimerai copier coller la couleur de police et le remplissage d'une plage de cellule à une autre.

Ma ligne de code ne marche pas...
Workbooks("DOUBLECHECK.XLSM").Sheets("AMY").Range("C7:O150").Interior.Color = Workbooks("Résultats Amy.XLSX").Sheets("Feuil1").Range("G2:S145").Interior.Color
Des idées...?

Merci!
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 5'714
Appréciations reçues : 333
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 14 juin 2019, 16:59

Bonjour,

si les cellules n'ont pas tous la même couleur tu doit le faire un par un (boucle)
si ils ont tous la même couleur
Workbooks("DOUBLECHECK.XLSM").Sheets("AMY").Range("C7:O150").Interior.Color = Workbooks("Résultats Amy.XLSX").Sheets("Feuil1").Range("G2").Interior.Color
Workbooks("DOUBLECHECK.XLSM").Sheets("AMY").Range("C7:O150").Font.Color = Workbooks("Résultats Amy.XLSX").Sheets("Feuil1").Range("G2").Font.Color
Vive ces nouvelles saisons qui nous colorent.
isabelle
Avatar du membre
vaffancolor
Membre fidèle
Membre fidèle
Messages : 260
Appréciations reçues : 7
Inscrit le : 30 mars 2018
Version d'Excel : 2016 FR

Message par vaffancolor » 14 juin 2019, 18:03

Merci! Je comprend mieux!
Peux tu me faire la boucle?
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 5'714
Appréciations reçues : 333
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 14 juin 2019, 18:33

re,

à tester,
note/ les 2 fichiers doivent être ouvert
Sub test()
Set wk1 = Workbooks("DOUBLECHECK.XLSM")
Set sh1 = wk1.Sheets("AMY")
Set wk2 = Workbooks("Résultats Amy.XLSX")
Set sh2 = wk2.Sheets("Feuil1")

For Each c In Range("C7:O150")
  x = c.Address
  r = Cells(c.Row - 5, c.Column + 4).Address
  sh1.Range(r).Interior.Color = sh2.Range(x).Interior.Color
Next c
End Sub
1 membre du forum aime ce message.
Vive ces nouvelles saisons qui nous colorent.
isabelle
Avatar du membre
vaffancolor
Membre fidèle
Membre fidèle
Messages : 260
Appréciations reçues : 7
Inscrit le : 30 mars 2018
Version d'Excel : 2016 FR

Message par vaffancolor » 17 juin 2019, 08:51

Salut,

C'est bon, merci!
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message