Copier coller juste le fond de la cellule (couleur)

Bonjour,

Sur ce code, qu'est ce que je dois modifier pour que si je copie colle ça me colle juste la couleur de fond, parce que j'ai bien mi le Pasteformats mais avec tout ce code bah ça me copie quand même le texte a l'intérieur de ma cellule copier et je ne comprend pas comment c'est possible du moins d'où ça peut venir.

Option Explicit
Dim mavaleur1, monadresse1, mavaleur2, monadresse2, mavaleur3, monadresse3, mainlibre, mainlibreadresse

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    '4 couleurs tableau haut
    If Not Intersect(Target, Range("G12:J12")) Is Nothing Then 'plage des couleur
        Cancel = True
        mavaleur1 = Target
        monadresse1 = Target.Address

    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Application.Intersect(ActiveCell, Range("N13:XFD20")) Is Nothing Then 'plage où placer les couleurs
        If Target.Count > 1 Then Exit Sub
        On Error Resume Next
        Target = mavaleur1
        Range(monadresse1).Copy
        Target.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

    End If
End Sub

Bonjour,

Je pense que l'événement Worksheet_BeforeRightClick est plus approprié que SelectionChange.

Option Explicit

Dim MonRange As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Count > 1 Then Exit Sub

    If Not Intersect(Target, Range("G12:J12")) Is Nothing Then 'plage des couleur
        Set MonRange = Target
        Cancel = True
    End If

End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

     If Target.Count > 1 Then Exit Sub

    If MonRange Is Nothing Then Exit Sub
    If Not Application.Intersect(Target, Range("N13:XFD20")) Is Nothing Then 'plage où placer les couleurs
        Target.Interior.Color = MonRange.Interior.Color
        Cancel = True
    End If

End Sub

C'est pas mal, mais si c'est possible de garder le SelectionChange vu que tout les VBA de mon Excel sont fait avec ça. De plus avec le click droit ça me fais plus vraiment pareil que avec le SelectionChange donc faut que je fasse surement un peu de modif mais je le garde en tête au cas ou.

Si tu ou quelqu'un d'autre à une solution en gardant le SelectionChange je suis pas contre parce que je pense vraiment que c'est possible.

Je pense que le soucis viens de ces 4 paramètres :

- mavaleur1 = Target

- monadresse1 = Target.Address

- Target = mavaleur1

- Range(monadresse1).Copy

Parce que les autres codes me paraissent vraiment correcte.

???

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

     If Target.Count > 1 Then Exit Sub

    If MonRange Is Nothing Then Exit Sub
    If Not Application.Intersect(Target, Range("N13:XFD20")) Is Nothing Then 'plage où placer les couleurs
        Target.Interior.Color = MonRange.Interior.Color
       ' Cancel = True
    End If

End Sub

Merci ça correspondrait a ce que je veux, par contre j'ai un petit soucis que je n'avais pas avant (avec mon code de base) mes cellules qui sont en "forme conditionnelle" ne sont pas pris en compte.

J'ai un calendrier avec samedi et dimanche en forme conditionnelle afin qu'ils aient une couleur différente de tout le reste, mais quand je click dessus rien ne change visuellement, mais si j'enlève cette forme conditionnelle elles le sont bien comme si la forme conditionnelle était au premier plan et que le code vba la mettais au second plan. Mais j'aimerais bien pour le voir sur samedi et dimanche malgré la forme conditionnelle.

Il faut supprimer la condition :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

     If Target.Count > 1 Then Exit Sub

    If MonRange Is Nothing Then Exit Sub
    If Not Application.Intersect(Target, Range("N13:XFD20")) Is Nothing Then 'plage où placer les couleurs
        With Target
             .FormatConditions.Delete
             .Interior.Color = MonRange.Interior.Color
        End With
    End If

End Sub

merci nickel ça fonctionne bien