VBA - Copier texte du dessus par double clics

Bonjour,

Je souhaiterai par double clics dans des cellules fusionnées d'une colonne spécifique, copier le contenu de la cellule du dessus et la vider si je clique une seconde fois.

J'imaginais un code du genre mais je ne vois pas comment l'adapter:

Private Sub Worksheet_BeforeDoubleClick2(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="."
    If Not Intersect(Target, Range("AG:AL")) Is Nothing Then
        Cancel = True
        If Target = "" Then
            Target = XXXXXXXXXXXXXX    <-------------
        Else
            Target = ""
        End If
    End If
    ActiveSheet.Protect Password:="."
End Sub

Avez-vous une astuce qui pourrait m'aider?

Mes meilleures salutations,

Thierry

Bonjour,

A tester :

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

    ActiveSheet.Unprotect Password:="."
    If Not Intersect(Target, Range("AG:AG")) Is Nothing Then
       If Target <> Target.Offset(-1, 0) Then
          Target = Target.Offset(-1, 0)
       Else
          Target.Offset(-1, 0) = ""
       End If

        Cancel = True
    End If
    ActiveSheet.Protect Password:="."

End Sub

Bonjour Eric,

Merci beaucoup pour votre code mais il y a une erreur d'exécution sur le If Target <>

J'avais oublié de préciser que les cellules en question étaient des cellules fusionnées (AG:AL).

Serait-ce la raison de cette erreur d'exécution?

Mes meilleures salutations,

Thierry

Salut Thierry,
Salut Kergresse,

j'ai bien une solution mais il nous faudrait un fichier-exemple à tester, histoire de ne pas tourner en rond...

A+

Bonjour Curulis57,

Voici le fichier pour une meilleure compréhension.

Meilleures salutations,

Thierry

Salut Thierry,

premier jet...

    'Pour copier le texte de la cellule du dessus par double clics
    If Not Intersect(Target, Range("AG:AL")) Is Nothing Then
        Cancel = True
        If Selection.Cells(1, 1) <> Selection.Cells(1, 1).Offset(-1, 0) Then
          Selection.Cells(1, 1) = Selection.Cells(1, 1).Offset(-1, 0)
        Else
          Selection.Cells(1, 1).Offset(-1, 0) = ""
        End If
    End If

Comprends pas bien la cohérence de ceci mais si cela correspond à tes besoins...

Selection.Cells(1, 1).Offset(-1, 0) = "" ??

A+

Re bonjour curulis57,

Votre code fonctionne bien avec une petite modification:

'Pour copier le texte de la cellule du dessus par double clics et la vider lorsque je double clics une seconde fois:

    If Not Intersect(Target, Range("AG:AL")) Is Nothing Then
        Cancel = True
        If Selection.Cells(1, 1) <> Selection.Cells(1, 1).Offset(-1, 0) Then
          Selection.Cells(1, 1) = Selection.Cells(1, 1).Offset(-1, 0)
        Else
          Target = ""
        End If
    End If

Merci pour votre aide.

Bon appétit et bon week-end !