[Résolu] Copier le contenu d'une cellule dans un commentaire

[LOLO13130]

Bonsoir à tout le forum,

Après maintes recherches et essais je m'en remets à vos compétences expertes...
Comme le titre l'indique, je cherche à réaliser une macro permettant de copier le contenu des cellules E3, E4, E5 et E6 de la feuille "BASE" (je précise que se sont des résultats de formules), et de l'insérer dans les cellules B3, D3, F3 et H3 de la feuille "Socle com" sous forme de commentaires.

L'idéal serait que la macro s'exécute à chaque changement de valeur dans la plage (E3:E6) de la feuille "BASE" et dans la cellule D9 de la feuille "Réglages", le tout sur des feuilles protégées par le mot de passe suivant : deblock

Feuille "BASE" > Feuille "Socle com"
E3 > B3
E4 > D3
E5 > F3
E6 > H3

Je joins un fichier coquille pour plus de clarté et faciliter votre éventuelle contribution.
Merci d'avance.
Laurent

 

[Rouge]

Bonjour,
Essayez ceci
https://www.cjoint.com/c/GLrfjrCnvrw
Cdlt

 

[laurent950]

Bonjour,
Une solution

feuil(Base) : Copier le code ci-dessous

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B3:B6")) Is Nothing Then
        ImportCommentaire
    End If
End Sub

Feuil(Réglages): Copier le code ci-dessous

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$9" Then
        ImportCommentaire
    End If
End Sub

Code Module :Copier le code ci-dessous

Sub ImportCommentaire()
' copier le contenu des cellules E3, E4, E5 et E6 de la feuille "BASE"
' insérer dans les cellules B3, D3, F3 et H3 de la feuille "Socle com" sous forme de commentaires
' la macro s'exécute à chaque changement de valeur dans la plage (E3:E6) de la feuille "BASE"
' et dans la cellule D9 de la feuille "Réglages"
' le tout sur des feuilles protégées par le mot de passe suivant : deblock

' 1) ' copier le contenu des cellules E3, E4, E5 et E6 de la feuille "BASE"
Dim Fbase As Worksheet
Set Fbase = Worksheets("BASE")
Dim i As Integer
Dim Tbase(0 To 3) As Variant
    For i = LBound(Tbase) To UBound(Tbase)
        Tbase(i) = Fbase.Cells(3 + i, 5)
    Next i
    i = Empty

' 2) ' le tout sur des feuilles protégées par le mot de passe suivant : deblock
Dim Fsocle As Worksheet
Set Fsocle = Worksheets("Socle com")
' Déprotéger
Fsocle.Unprotect ("deblock")
' Traiment remplire commentaire
    Dim j As Integer
    j = 2
    For i = LBound(Tbase) To UBound(Tbase)
        Fsocle.Cells(3, j).ClearComments
        Fsocle.Cells(3, j).AddComment
        Fsocle.Cells(3, j).Comment.Visible = False
        Fsocle.Cells(3, j).Comment.Text Text:=Tbase(i)
    j = j + 2
    Next i
i = Empty
j = Empty

Fsocle.Protect ("deblock")
Fsocle.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Cdt
Laurent

 

[LOLO13130]

Bonsoir au forum et à vous Rouge et Laurent,

Un grand merci car vos 2 solutions fonctionnent très bien !!

J'ai encore une petite demande avec le déclenchement de la macro.
Je souhaiterais réécrire la private sub worksheet_change de la feuille "Réglages" selon les 2 conditions suivantes (je précise que le contenu de la cellule D9 est du texte issu d'une liste déroulante) :
Condition 1 :
Si la cellule D9 change ET si D9="Niveau 1", alors lancer la macro "commentaires_N1"
Condition 2 :
Si la cellule D9 change ET si D9="Niveau 2", alors lancer la macro "commentaires_N2"

Merci d'avance.
Cordialement.
Laurent

 

[Rouge]

Bonjour,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$9" And Target.Address = "Niveau 1" Then
commentaires_N1
ElseIf Target.Address = "$D$9" And Target.Address = "Niveau 2" Then
commentaires_N2
End If
End Sub
En supposant que les macros "Commentaires_N1" et "Commentaires_N2" soit déjà créées par vous même.
Cdlt

 

[LOLO13130]

Bonsoir rouge,

Merci beaucoup, c'est exactement ce qu'il me fallait.
Toujours aussi matinal et efficace !!!
Je marque le sujet comme résolu.

Merci à toi et à tout le forum pour le partage des compétences.
Très cordialement.
Laurent