Modifs macro pour copier/coller

Bonjour le forum

Il y a assez longtemps quelqu'un du forum avait fait les 2 macros ci-dessous

Une pour déplacer les commentaires sur tout le classeur macro ci-dessous

Sub DeplacerCommentairesClasseur()
ActiveSheet.Unprotect
Dim Ws As Worksheet, WsActu As Worksheet
Dim Cel1 As Range
Dim Cel2 As Range

   ActiveSheet.Unprotect
   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:
   ActiveSheet.Protect
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

Une pour déplacer les commentaires sur la feuille macro ci-dessous

Sub DeplacerCommentairesFeuille()
   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 destination", , , , , , , 8)

    Application.ScreenUpdating = False
    Cel1.Copy
    Cel2.PasteSpecial xlPasteComments, xlNone

    Cel1.ClearComments

    Application.CutCopyMode = False

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

Je voudrais SVP 2 autres macros pour copier coller sur classeur et feuille

Je pourrais faire copier => collage spécial => commentaires mais par macros c'est bien

Je n'ai pas essayé de "bricoler" les macros!!!

Merci pour vos éventuels retours

Cordialement

Bonjour,

Pour les copier-coller, sauf erreur, il suffit de reprendre à l'identique ces 2 macros et de supprimer les lignes :

Ws.Range(Cel1.Address).ClearComments

qui effacent les commentaires de la cellule d'origine.

Cordialement,

Bonsoir 3GB

Exact. Je met en commentaire les lignes et hop ça fonctionne. Ne pas oublier de les remettre en non commentaire

Classeur

Ws.Range(Cel1.Address).ClearComments 

WsActu.Range(Cel1.Address).ClearComments

Feuille

Cel1.ClearComments

Merci à toi

Bonne fin de soirée

Cordialement

Merci, bonne soirée à toi aussi !