Modifier et copier une cellule par clic sur elle

Bonjour Denis

Il est inutile de mener la discussion sur 2 fils différents !
Alors en adaptant la macro que Gyrus, que je salue au passage, t'avait fourni sur l'autre fil

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n As Integer, w As Integer, lg As Integer, ligB As Integer
If Target.Count > 1 Then Exit Sub
'si cellule vide ou dans une autre colonne que la A ou ligne >20 ne rien faire
    If Target.Value = "" Or Target.Column > 1 Or Target.Row > 20 Then Exit Sub
    
' si cellule blanche
    If Target.Interior.Pattern = xlNone Then
    ' boucle sur 20 lignes de col A et comptabilise cellules bleues
    For n = 1 To 20
    If Range("A" & n).Interior.Color = 15773696 Then w = w + 1
    Next
        ' si nombre cellules bleues inférieur à 9
        If w < 10 Then
            ' boucle sur les 20 lignes col B à partir de la fin pour trouver 1ere cellule vide
                For lg = 20 To 1 Step -1
                If Range("B" & lg).Value = "" Then ligB = lg
                Next
            ' execution macro bleu avec la cellule du clic comme cellule source et la cellule vide comme cellule cible
            MiseEnFormeBleu Target, Range("B" & ligB)
        End If
    Exit Sub
    End If
    
 ' sinon (cas de cellule bleue)
         ' recherche ligne en col B ou se trouve la même valeur
        ligB = Columns(2).Find(Target.Value, , , , xlByColumns, xlPrevious).Row
        ' puis execution macro bleu avec la cellule du clic comme cellule source et la cellule en B comme cellule cible
        MiseEnFormeBlanc Target, Range("B" & ligB)
       
End Sub
Sub MiseEnFormeBleu(CelS As Range, CelC As Range)
    With CelS
   
            'le fond de la cellule passe en couleur bleu ciel
            .Interior.Color = 15773696
            'la police passe en couleur blanche.
            .Font.ThemeColor = xlThemeColorDark1
            'Copie en col B
            CelC = .Value
            End With
            
        End Sub
 Sub MiseEnFormeBlanc(CelS As Range, CelC As Range)
        
         With CelS
            'supppression du remplissage
            .Interior.Pattern = xlNone
            'la police passe en couleur automatique.
            .Font.ColorIndex = xlAutomatic
            'Effacement en col B
            CelC.ClearContents
        End With
End Sub

Cdlmnt
Via

Bonjour via55

La macro créée suite à votre réponse ne s'exécute pas et fait se déclencher le message suivant : " Erreur de compilation. Instruction incorrecte dans une procédure". Ou ai-je commis une ou des erreurs ?

Merci
Denis 14

Sub Macro1()

' Macro1 Macro
' Macro enregistrée le 31/10/2015 par Denis
'

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n As Integer, w As Integer, lg As Integer, ligB As Integer
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Or Target.Column > 1 Or Target.Row > 20 Then Exit Sub
If Target.Interior.Pattern = xlNone Then
For n = 1 To 20
If Range("A" & n).Interior.Color = 15773696 Then w = w + 1
Next
If w < 10 Then
For lg = 20 To 1 Step -1
If Range("B" & lg).Value = "" Then ligB = lg
Next
MiseEnFormeBleu Target, Range("B" & ligB)
End If
Exit Sub
End If
ligB = Columns(2).Find(Target.Value, , , , xlByColumns, xlPrevious).Row
MiseEnFormeBlanc Target, Range("B" & ligB)

End Sub
Sub MiseEnFormeBleu(CelS As Range, CelC As Range)
With CelS

.Interior.Color = 15773696
.Font.ThemeColor = xlThemeColorDark1
CelC = .Value
End With
End Sub
Sub MiseEnFormeBlanc(CelS As Range, CelC As Range)

With CelS
.Interior.Pattern = xlNone
.Font.ColorIndex = xlAutomatic
CelC.ClearContents
End With
End Sub

Bonjour Denis

Enlève la ligne du début qui n'appartient pas à la macro et qui doivent provoquer l'erreur,

Sub Macro1()

' Macro1 Macro
' Macro enregistrée le 31/10/2015 par Denis

Cdlmnt
Via
'