Déplacer commentaires sur tout un classeur

Bonjour le forum

Je ne sais plus qui m'a fait cette macro qui fonctionne super bien

Je crois que c'est Theze mais je crois qu'il est en vacances.

Ça déplace les commentaires sur une feuille seulement.

Serait-il possible de les déplacer sur un classeur entier qui va de Janvier 2018 à Décembre 2018?

Et pas seulement à partir de Janvier 2018. Quelque soit le mois où on se trouve.

Merci d'avance pour vos éventuels retours.

Cordialement

Sub DeplacerCommentaires()
   ActiveSheet.Unprotect
   Application.EnableEvents = False
    Dim Cel1 As Range
    Dim Cel2 As Range

    On Error GoTo Fin

    Set Cel1 = Application.InputBox("Cellule d'origine", , , , , , , 8)
    Set Cel2 = Application.InputBox("Cellule de distination", , , , , , , 8)

    Cel1.Copy
    Cel2.PasteSpecial xlPasteComments, xlNone

    Cel1.ClearComments

    Application.CutCopyMode = False

Fin:
ActiveSheet.Protect
   Application.EnableEvents = True
End Sub

Dans la feuille du mois il y a cette macro également

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, [A2:A8]) Is Nothing Then Exit Sub       'Jouer sur [A2:A8] pour la plage des commentaires à déplacer
  If Not Target.Comment Is Nothing Then AfficherMasquerDistanceMoisPrecedent  'AfficherMasquerDistanceMoisPrecedent = Nom Macro
End Sub

Cette macro aussi pour les copier dans tout le classeur mais les commentaires existent que sur une feuille (Janvier 2018)

Option Explicit
Sub CopieCommentairesClasseur()
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("Janvier 2018") 'définit l'onglet de référence R (celui où il y a le commentaire, à adapter)
  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
  MsgBox "commentaire à copier :  " & TC
  Application.EnableEvents = False
  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
       R.Range("A3").Copy O.Range("A3")
     End If 'fin de le condition
  Next O 'prochain onglet de la boucle
  Application.EnableEvents = True
End Sub

Bonjour le forum

Personne pour s'y coller?

Merci à vous pour vos éventuels retours

Bonjour,

peut-être qu'un fichier de travail avec tous les cas de figure motiverait les vocations.

En 5 ans tu ne l'as pas remarqué ?

eric

Voilà,

Je voudrais déplacer les commentaires qui se trouvent cellule A3 de tous les mois dans une cellule à désigner.

Une macro existe => Sub DeplacerCommentaires() mais pour un mois.

Est-il possible de la faire executer à partir du mois en cours (exemple juillet 2018) mais réalisé dans tous les mois (c'est à dire pas obligé d'afficher tous les mois)?

Bien évidemment il faudra quand même ouvrir pour voir si c'est bien réalisé

Merci pour vos éventuels retours

Bien cordialement

Bonjour le forum

J'ai réussi enfin à faire cette macro pour déplacer sur un classeur => Sub DeplacerCommentairesClasseur()

Et celle-ci pour une feuille => Sub DeplacerCommentairesFeuille()

J'ai pensé faire mettre un message de ne pas oublier de modifier les commentaires (Cliquez cellule A3 Distance Mois Précédent )

Si on les déplacent cellule A4 par exemple il faut modifier les commentaires (Cliquez cellule A4 Distance Mois Précédent )

Là je ne sais pas comment le faire et où dans les macros.

Dans les 2 macros => Sub DeplacerCommentairesClasseur() et Sub DeplacerCommentairesFeuille()

Quelqu'un aurait-il une idée comment le faire?

Merci pour vos éventuels retours

Cordialement

Voilà

Bonne fin de soirée à tous

Cordialement

Option Explicit

Sub DeplacerCommentairesClasseur()              'Ne pas oublier de modifier les commentaires avant de lancer la macro
Dim Ws As Worksheet, WsActu As Worksheet
Dim Cel1 As Range
Dim Cel2 As Range

   Application.EnableEvents = False
    Set Cel1 = Application.InputBox("Cellule d'origine", , , , , , , 8)
    Set Cel2 = Application.InputBox("Cellule de destination", , , , , , , 8)
    Set WsActu = ActiveSheet

   Application.ScreenUpdating = False
    For Each Ws In Worksheets          'boucle sur tous les onglets Ws du classseur

      If Ws.Name <> WsActu.Name Then    'condition : si le nom de l'onglet Ws est différent du nom de l'onget de référence WsActu
        If Not Ws.Range(Cel1.Address).Comment Is Nothing Then
          Ws.Unprotect
          WsActu.Range(Cel1.Address).Copy
          Ws.Range(Cel2.Address).PasteSpecial xlPasteComments, xlNone
          Ws.Range(Cel1.Address).ClearComments
          Ws.Protect
        End If     'fin de le condition
       End If
    Next Ws        'prochain onglet de la boucle

      WsActu.Unprotect
      WsActu.Range(Cel1.Address).Copy
      WsActu.Range(Cel2.Address).PasteSpecial xlPasteComments, xlNone
      WsActu.Range(Cel1.Address).ClearComments
      WsActu.Protect
    Application.CutCopyMode = False

Fin:
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub