Copier Coller commentaires dans autre cellule

Colles tout le code ci-dessous dans le module de la feuille (il remplace l'existant) et testes (il n'y à plus de boite de message, ça se joue entre A2 et A3) :

Dim Suspendre As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Com As Comment

    If Suspendre = True Then Exit Sub

    Set Com = Target.Comment

    If Target.Address = "$A$3" Then

        If Com Is Nothing Then

            Exit Sub

        Else

            Application.EnableEvents = False

            Commentaire Target, Range("A2")
            Range("G:I").EntireColumn.Hidden = True

        End If

    End If

    If Target.Address = "$A$2" Then

        If Com Is Nothing Then

            Exit Sub

        Else

            Application.EnableEvents = False

            Commentaire Target, Range("A3")
            Range("G:I").EntireColumn.Hidden = False

        End If

    End If

    Application.EnableEvents = True

End Sub

Private Sub Commentaire(Cible As Range, Cel As Range)

    Cible.Copy

    Cel.PasteSpecial xlPasteComments, xlNone

    Cible.ClearComments

    Suspendre = True
    Cible.Select
    Suspendre = False

    Application.CutCopyMode = False

End Sub

@These

Donc les commentaires y sont deux fois? A2 et A3?

Il faut passer par l'une et par l'autre pour afficher / Masquer?

Grosse avancée mais nous n'y sommes pas tout à fait

je ne sais pas si c'est possible de faire Afficher / Masquer qu'à partir de la A2 car c'est celle-ci qui remplace la A3.

Je pense que c'est très dur à faire

A+ peut - être

Cordialement

Désolé d'avoir de la peine à comprendre !

Testes ce code si il peut convenir, seule la cellule A2 permet d'afficher/masquer les colonnes (adaptes pour le commentaire si il doit ou non changer de cellule A2 vers A3) :

Dim Suspendre As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Com As Comment

    If Suspendre = True Then Exit Sub

    Set Com = Target.Comment

    If Target.Address = "$A$3" Then

        If Com Is Nothing Then

            Exit Sub

        Else

            Application.EnableEvents = False

            Commentaire Target, Range("A2")

        End If

    End If

    If Target.Address = "$A$2" Then

        If Com Is Nothing Then

            Exit Sub

        Else

            Application.EnableEvents = False

            Commentaire Target, Range("A3")
            Range("G:I").EntireColumn.Hidden = Not Range("G:I").EntireColumn.Hidden

        End If

    End If

    Application.EnableEvents = True

End Sub

Private Sub Commentaire(Cible As Range, Cel As Range)

    Cible.Copy

    Cel.PasteSpecial xlPasteComments, xlNone

    Cible.ClearComments

    Suspendre = True
    Cible.Select
    Suspendre = False

    Application.CutCopyMode = False

End Sub

@Theze

Non pas ça

Ce qui est le mieux c'est ça

Ta macro:

Sub CopierCommentaires()
   ActiveSheet.Unprotect
    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
End Sub

Jusque là tout va bien. Les commentaires passent bien de A3 à A2

Ensuite je vais manuellement dans la macro de la feuille:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  'Cette MACRO ne fonctionne pas sur Cellule FUSIONNÉE (Cellule "$A$3")
If Target.Address = "$A$3" Then                 'Cellule à cliquez pour afficher et masquer Colonnes G à I et lignes vides
Call LignesRegularisationColonnesExplications   'NOM de la MACRO => LignesRegularisationColonnesExplications
End If
End Sub

Et je mets 2 à la place de 3 dans "$A$3"

Et terminé c'est parfait.

Ce que je voulais faire c'est que ça le fasse automatiquement

Je pensais qu'on pouvais incorporer la macro de la feuille dans celle => Sub CopierCommentaires

Pas plus que ça

Merci à toi pour ce boulot

Peut-être à plus

Cordialement

Bonjour,

Alors utilises une variable que tu inverses entre 2 et 3 dans l’adresse de la cellule :

If Lig = 2 Then Lig = 3 Else Lig = 2
If Target.Address = "$A$" & Lig Then  

@Theze

Après une compilation de tes "pistes" et des déductions que j'ai faites voici quelques modifs et ça tourne comme une horloge.

Ta premère macro à laquelle j'ai ajouté en rouge (je ne sais pas si ça va se voir) Application.EnableEvents = False et True

Un GRAND merci pour ton implication et ta constance...Car il faut en avoir avec moi!!!

Je te renouvelle tous mes remerciements et passe une bonne fin de journée ou de ...soirée

Bien cordialement à toi.

Sub CopierCommentaires()
   ActiveSheet.Unprotect
   [color=#FF0000]Application.EnableEvents = False
[/color]    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
   [color=#FF0000]Application.EnableEvents = True
[/color]End Sub

Puis celle existante modifiée:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  'Cette MACRO ne fonctionne pas sur Cellule FUSIONNÉE (Cellule "$A$3")
  If Target.Address = "$A$2" And Not Target.Comment Is Nothing Then                  'Cellule à cliquez pour afficher et masquer Colonnes G à I et lignes vides
    Call LignesRegularisationColonnesExplications   'NOM de la MACRO => LignesRegularisationColonnesExplications
  ElseIf Target.Address = "$A$3" And Not Target.Comment Is Nothing Then                  'Cellule à cliquez pour afficher et masquer Colonnes G à I et lignes vides
    Call LignesRegularisationColonnesExplications   'NOM de la MACRO => LignesRegularisationColonnesExplications
  End If
End Sub

L’important est que tu sois arrivé à ce que tu veux !

Content d’avoi pus t’aider

Je ne peux rien tester, je suis sur mon IPhone car c’est mon premier jour de congés

@Theze

Encore merci et bonnes vacances

Cordialement

Bonjour le forum,

Theze étant en vacances quelqu'un veut-il s'y coller?

J'ai fait ça qui fonctionne très bien mais y a t-il mieux à faire?

"Condenser" la macro?

Merci d'avance

Cordialement

Private Sub Worksheet_SelectionChange(ByVal Target As Range)               'Cette MACRO ne fonctionne pas sur Cellule FUSIONNÉE (Cellule "$A$3")
  If Target.Address = "$A$2" And Not Target.Comment Is Nothing Then        'Cellule à cliquez pour afficher et masquer Colonnes G à I et lignes vides
    Call LignesRegularisationColonnesExplications                          'NOM de la MACRO => LignesRegularisationColonnesExplications
  ElseIf Target.Address = "$A$3" And Not Target.Comment Is Nothing Then
        Call LignesRegularisationColonnesExplications                      'NOM de la MACRO => LignesRegularisationColonnesExplications
  ElseIf Target.Address = "$A$4" And Not Target.Comment Is Nothing Then
    Call LignesRegularisationColonnesExplications                          'NOM de la MACRO => LignesRegularisationColonnesExplications
  ElseIf Target.Address = "$A$5" And Not Target.Comment Is Nothing Then
    Call LignesRegularisationColonnesExplications                          'NOM de la MACRO => LignesRegularisationColonnesExplications
  ElseIf Target.Address = "$A$6" And Not Target.Comment Is Nothing Then
    Call LignesRegularisationColonnesExplications                          'NOM de la MACRO => LignesRegularisationColonnesExplications
  ElseIf Target.Address = "$A$7" And Not Target.Comment Is Nothing Then
    Call LignesRegularisationColonnesExplications                          'NOM de la MACRO => LignesRegularisationColonnesExplications
    ElseIf Target.Address = "$A$8" And Not Target.Comment Is Nothing Then
    Call LignesRegularisationColonnesExplications                          'NOM de la MACRO => LignesRegularisationColonnesExplications

  End If

End Sub

Bonjour al87, le forum,

je te propose cette optimisation de ton code VBA (à tester) :

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
  If Not Target.Comment Is Nothing Then LignesRegularisationColonnesExplications
End Sub

dhany

Bonjour dhany

SUPER.

Merci à toi et bon 14 juillet devant le PC

Bonne fin de journée

Bien cordialement

merci pour ton retour ! et bonnes fêtes du 14 juillet à toi aussi !

bonne fin de journée également.

dhany