VBA - Double clics dans tableau pour copier texte dans cellule spécifique

Re,

Voici un fichier exemple de ce que je souhaite:

Je souhaite double cliquer sur les cellules B5:AA5 (cellules verrouillées) et que le nom inscrit dans la cellule se copie dans la cellule AG8 (cellule déverrouillée).
Idem pour les cellules A6:A31 dans AG10.

Mes meilleures salutations,

Thierry

Bonjour Thierry36,

Voici un code, à adapter à ton besoin

Code à placer dans le module de la feuille où se trouve la donnée à copier/coller (Alt+F11 pour ouvrir le projet VBA)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim MSG As String, MDP As String
Dim Sh As Worksheet

    MDP = "1234" 'A adapter : code de protection de la feuille
    If Intersect(Target, Range("B5:AA5")) Is Nothing Then
        If Target.Value = "" Then Exit Sub
        MSG = MsgBox("Voulez-vous copier """ & Target.Value & """ sur la feuille protégée ?", vbExclamation + vbYesNo)
        ActiveSheet.Unprotect MDP
        Range("AG8").Value = Target.Value
        ActiveSheet.Protect MDP
        MsgBox "Copier/coller de la cellule ok", vbExclamation
    End If
    If Intersect(Target, Range("A6:A31")) Is Nothing Then
        If Target.Value = "" Then Exit Sub
        MSG = MsgBox("Voulez-vous copier """ & Target.Value & """ sur la feuille protégée ?", vbExclamation + vbYesNo)
        ActiveSheet.Unprotect MDP
        Range("AG10").Value = Target.Value
        ActiveSheet.Protect MDP
        MsgBox "Copier/coller de la cellule ok", vbExclamation
    End If
End Sub

Bonjour GG,

Merci pour votre retour; votre code fonctionne parfaitement bien lorsque la feuille est déverrouillée et que les cellules AG8 et AG10 sont vides mais malheureusement pas quand la feuille est verrouillée et que les cellules AG8 et AG10 sont remplies.

Meilleures salutations,

Thierry

Re bonjour,

J'y suis arrivé avec ce code mais les cellules verrouillées doivent pouvoir être sélectionnées:

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

If Not Application.Intersect(Target, Range("B5:AA5")) Is Nothing Then
    ActiveSheet.Unprotect "."
    [AG8] = ActiveCell.Value
    ActiveSheet.Protect "."
End If

If Not Application.Intersect(Target, Range("A6:A31")) Is Nothing Then
    ActiveSheet.Unprotect "."
    [AG10] = ActiveCell.Value
    ActiveSheet.Protect "."
End If
Cancel = True
End Sub

Meilleures salutations,

Thierry