Copie des valeurs + formats de cellule

[pierre4]

bonjour
j'ai 3 onglets : devis ouvrages appro

dans ouvrages, je choisi format de cellules gras couleur etc...

je voudrais que les formats de cellules gras ou couleur ...
se copient sur les autres onglets...devis et appro

Attention dans devis et appro les cellules s'inscrivent toutes seules depuis ouvrage, via la commande ligne,
elles s'insèrent automatiquement, ou se disparaissent
merci de votre aide
voir fichier...
vive le forum
Pierre

 

[JNP]

Re : Copie des valeurs + formats de cellule

Bonjour Pierre4 ,
A mettre dans ThisWorkbook

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Plage As Range, Cellule As Range, Recherche As Range
If Sh.Name = "Devis" Then
    Set Plage = Sh.Range("D18:D41")
ElseIf Sh.Name = "Appro" Then
    Set Plage = Sh.Range("B2:B35")
Else
    Exit Sub
End If
For Each Cellule In Plage
    If Not Cellule.Value = "" Then
        Set Recherche = Sheets("Ouvrages").Range("F:F").Find(Cellule, lookat:=xlWhole)
        Cellule.Interior.Color = Recherche.Interior.Color
        Cellule.Font.Bold = Recherche.Font.Bold
    End If
Next Cellule
End Sub

Bonne journée

 

[pierre4]

Re : Copie des valeurs + formats de cellule

Bonjour JNP
merci pour ton aide bien utile.

Set Recherche = Sheets("Ouvrages").Range("F:F").Find(Cellule, lookat:=xlWhole)
Cellule.Interior.Color = Recherche.Interior.Color Cellule.Font.Bold = Recherche.Font.Bold

1/ erreur débogage sur "Cellule.Interior.Color "
2/ peut t-on étendre aussi la hauteur de police
3/ rajouter à "range("F:F") colonnes C K L M N...

belle journée ensoleillée .

 

[JNP]

Re : Copie des valeurs + formats de cellule

Set Recherche = Sheets("Ouvrages").Range("F:F").Find(Cellule, lookat:=xlWhole)
Cellule.Interior.Color = Recherche.Interior.Color Cellule.Font.Bold = Recherche.Font.Bold

1/ erreur débogage sur "Cellule.Interior.Color "
2/ peut t-on étendre aussi la hauteur de police
3/ rajouter à "range("F:F") colonnes C K L M N...

1/ En réalité l'erreur vient du dessus . La recherche n'a pas trouvé ta référence, mais c'est ta faute ... Tu as dis que tes cellules étaient issues du calcul de l'autre feuille, donc en principe, le Find doit toujours trouver une cellule de référence... Modifie ainsi

    If Not Cellule.Value = "" Then
        Set Recherche = Sheets("Ouvrages").Range("F:F").Find(Cellule, lookat:=xlWhole)
        If Not Cellule Is Nothing Then
            Cellule.Interior.Color = Recherche.Interior.Color
            Cellule.Font.Bold = Recherche.Font.Bold
        End If
    End If

2/ L'enregistreur de macro (en modifiant ce que tu veux comparer dans la cellule) te donnera tous les critères dont tu as besoin, ici

.Font.Size

3/ La réponse est dans la question

Range("A:A,C:C")

Mais attention, à mélanger les torchons et les serviettes, tu risques des surprises ...
Bon courage

 

[pierre4]

Re : Copie des valeurs + formats de cellule

merci pour l'info,
j'ai pas tout compris, et j'ai modifié

il me mets "erreur compilation"
"next sans for"

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Plage As Range, Cellule As Range, Recherche As Range
If Sh.Name = "Devis" Then
Set Plage = Sh.Range("D1841")
ElseIf Sh.Name = "Appro" Then
Set Plage = Sh.Range("B2:B35")
Else
Exit Sub
End If
For Each Cellule In Plage
If Not Cellule.Value = "" Then
Set Recherche = Sheets("Ouvrages").Range("F:F").Find(Cellule, lookat:=xlWhole)
If Not Cellule Is Nothing Then
Cellule.Interior.Color = Recherche.Interior.Color
Cellule.Font.Bold = Recherche.Font.Bold
Cellule.Font.Size = Recherche.Font.Size
End If
Next Cellule
End Sub

à suivre si vous pouvez m'aider ...

 

[Hippolite]

Re : Copie des valeurs + formats de cellule

Bonjour à tous,
Il manque un End If vers la fin
A+

 

[JNP]

Re : Copie des valeurs + formats de cellule

Re ,

Il manque un End If vers la fin

Qui apparait nettement dans mon #4 ...
Bon WE

 

[pierre4]

Re : Copie des valeurs + formats de cellule

oui j'ai rectifié le tir de End If
cependant j'ai ce message:

erreur d'exécution "91":
variable objet ou variable de bloc With non définie
fin ou débogage...

il me fluaute cette 1ere ligne :
Cellule.Interior.Color = Recherche.Interior.Color
Cellule.Font.Size = Recherche.Font.Size
Cellule.Font.Bold = Recherche.Font.Bold
Cellule.Font.Color = Recherche.Font.Color

à corriger, mais ou quoi.
a+ bon WE à vous
Pierre

 

[Hippolite]

Re : Copie des valeurs + formats de cellule

Bonsoir,
Donne ton code en entier si tu veux qu'on puisse l'analyser.
Pour que le code soit facile à lire, utilise les balises de code (Aller en mode avancé, bouton #) ou encore mieux, utilise les balises qui sont dans ma signature.
A+

 

[pierre4]

Re : Copie des valeurs + formats de cellule

voilà, mais je n'y comprends pas grand chose!

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Plage As Range, Cellule As Range, Recherche As Range
If Sh.Name = "Devis" Then
Set Plage = Sh.Range("C18:H40")
ElseIf Sh.Name = "Appro" Then
Set Plage = Sh.Range("B2:E100")
ElseIf Sh.Name = "Métrés" Then
Set Plage = Sh.Range("A1:B1000")
Else
Exit Sub
End If
For Each Cellule In Plage
If Not Cellule.Value = "" Then
Set Recherche = Sheets("Ouvrages").Range("D,G:G").Find(Cellule, lookat:=xlWhole)
If Not Cellule Is Nothing Then
Cellule.Font.Size = Recherche.Font.Size
Cellule.Font.Bold = Recherche.Font.Bold
Cellule.Font.Color = Recherche.Font.Color
End If
End If
Next Cellule
End Sub

 

[JNP]

Re : Copie des valeurs + formats de cellule

Re ,
Je devais être un peu fatigué, moi ...
C'est

If Not Recherche Is Nothing Then

et non

If Not Cellule Is Nothing Then

tout simplement ...
Bonnes Pâques

 

[pierre4]

Bonjour JNP,
là c'est bon , ça marche bien, Super...
merci****

belle journée
Pierre

 

[pierre4]

Re : Copie des valeurs + formats de cellule

bonjour,
... suite à mes messages:

je voudrais savoir la formule pour conserver la hauteur de ligne (et non la cellule...)

comme pour les cellules au dessus:...y a t il un site particulier à l'initiation du VBA ?

Cellule.Font.Size = Recherche.Font.Size
Cellule.Font.Bold = Recherche.Font.Bold
Cellule.Font.Color = Recherche.Font.Color

Merci
bonne journée.

 

[Pierrot93]

Re : Copie des valeurs + formats de cellule

Bonjour,

essaye ceci :

cellule.EntireRow.Height = Recherche.EntireRow.Height

bonne journée
@+

 

[pierre4]

Re : Copie des valeurs + formats de cellule

Pierrot
à revoir ...message:
erreur d'éxécution "424"
objet requis

merci de ton aide