Copier Commentaires d'un cellule dans tout le classeur

[un internaute]

Bonjour le forum
Je voudrais copier les commentaires d'une cellule A3 dans la même cellule de tout le classeur (12 feuilles) par macro
Est-ce possible?
Merci d'avance
Cordialement

 

[Robert]

Bonjour un internaute, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim R As Worksheet 'déclare la variable R (onglet de Référence)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As String 'déclare la variable TC (Texte du Commentaire)

Set R = Worksheets("Feuil1") 'définit l'onglet de référence R (celui où il y a le commentaire, à adapter à ton cas)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
TC = R.Range("A3").Comment.Text 'définit le texte du commentaire TC (génère une erreur si A3 ne contient pas de commentaire)
If Err <> 0 Then 'condition : si une erreur a été générée
    MsgBox "il n'y a pas de commentaire ! Action terminée." 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
For Each O In Worksheets 'boucle sur tous les onglets O du classseur
    If O.Name <> R.Name Then 'condition : si le nom de l'onglet O est différent du nom de l'onget de référence R
        With O.Range("A3") 'prend en compte la cellule A3 de l'onglet de la boucle
            .Comment.Delete 'supprime un éventuel commentaire déjà existant
            .AddComment 'ajoute un commentaire
            Comment.Text = TC 'définit le texte du commentaire ajouté
        End With 'fin de la prise en compte de la cellule A3
    End If 'fin de le condition
Next O 'prochain onglet de la boucle
End Sub

 

[un internaute]

Bonjour un internaute, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim R As Worksheet 'déclare la variable R (onglet de Référence)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As String 'déclare la variable TC (Texte du Commentaire)

Set R = Worksheets("Feuil1") 'définit l'onglet de référence R (celui où il y a le commentaire, à adapter à ton cas)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
TC = R.Range("A3").Comment.Text 'définit le texte du commentaire TC (génère une erreur si A3 ne contient pas de commentaire)
If Err <> 0 Then 'condition : si une erreur a été générée
    MsgBox "il n'y a pas de commentaire ! Action terminée." 'message
    Exit Sub 'sort de la procédure
End If 'fin de la condition
For Each O In Worksheets 'boucle sur tous les onglets O du classseur
    If O.Name <> R.Name Then 'condition : si le nom de l'onglet O est différent du nom de l'onget de référence R
        With O.Range("A3") 'prend en compte la cellule A3 de l'onglet de la boucle
            .Comment.Delete 'supprime un éventuel commentaire déjà existant
            .AddComment 'ajoute un commentaire
            Comment.Text = TC 'définit le texte du commentaire ajouté
        End With 'fin de la prise en compte de la cellule A3
    End If 'fin de le condition
Next O 'prochain onglet de la boucle
End Sub

Bonjour Robert
Presque SUPER.
Ça copie le rectangle de mes commentaires mais sans les commentaire.
J'ais mis Janvier 2018 à la place de Feuil1
Mais commentaires sont sur 2 lignes:
Cliquez cellule A3
Distance Mois Précédent
Merci à +
Cordialement

 

[un internaute]

Bonjour le forum,
Personne pour "améliorer" lamacro de Robert?
Elle est "presque" nickel.
J'ai fait qui fonctionne mais il y a beaucoup mieux à faire
Cordialement

Sub Macro3()
    Range("A3").Select
    Selection.Copy
    Sheets("Janvier 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
   
    Sheets("Février 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Sheets("Mars 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Avril 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Mai 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Sheets("Juin 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Sheets("Juillet 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Sheets("Août 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Sheets("Septembre 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Sheets("Octobre 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Sheets("Novembre 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Sheets("Décembre 2018").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub