Extraire les commentaires

Bonsoir à toutes et à tous

Sur le fichier joint, je souhaiterai récupérer les commentaires des cellules de la feuil1 sur la Feuil2 dans la colonne C

Par exemple, lorsque je clique sur le client 1 dans la liste déroulante Feuil2/B1, le commentaire repris en Feuil1/E2 s'afficherait sur la Feuil2/C5. Autre exemple, lorsque je clique sur le client 2 dans la liste déroulante Feuil2/B1, le commentaire repris en Feuil1/J3 s'afficherait sur la Feuil2/C10.

J'ai trouvé un code sur le net que j'ai tenté d'adapter à mon fichier, mais cela bugge. ci dessous le code :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Sheets("Feuil1").Selected

If Intersect(ActiveCell, [A2:AT10000]) Is Nothing Then Exit Sub

[C2] = "" 'RAZ

On Error Resume Next

Sheets("Feuil2").Selected

[C2] = ActiveCell.Comment.Text

End Sub

merci de vos commentaires avisés

chb44

Bonsoir,

une proposition, rajoute les lignes surlignées dans ton code

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Application.Intersect(Target, Range("B1")) Is Nothing Then
        On Error GoTo fin
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set Wss = Worksheets("Feuil1")
        Set Wsd = Worksheets("Feuil2")
        With Wss
            Derligne = .Range("A" & Rows.Count).End(xlUp).Row
            Set Plage = .Range("A2:A" & Derligne)
            Set c = Find_Range(Wsd.[B1], Plage, xlValues, xlWhole)
            num = c.Row
            Set Plage = .Range(.Cells(c.Row, 2), .Cells(c.Row, nbCol))
            Plage.Copy
            Wsd.[B2].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
            Wsd.[A5] = c.Row
For Each c In Plage
             On Error Resume Next
             Wsd.Cells(c.Column, 3) = c.Comment.Text
            Next
            On Error GoTo 0
            Wsd.[A1].Activate
        End With
    End If
    Application.EnableEvents = True
    Set Wss = Nothing: Set Wsd = Nothing: Set Plage = Nothing: Set c = Nothing

fin:
    Application.EnableEvents = True

End Sub

bonjour

j'ai incorporé ta partie de code au sein de mon code mais rien ne se passe ...

je ne comprends pas pourquoi

pour info, voici le code corrigé :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheets("Feuil1").Selected
If Intersect(ActiveCell, [A2:AT10000]) Is Nothing Then Exit Sub
[C2] = "" 'RAZ
On Error Resume Next
Sheets("Feuil2").Selected
[C2] = ActiveCell.Comment.Text
For Each c In Plage
             On Error Resume Next
             Wsd.Cells(c.Column, 3) = c.Comment.Text
            Next
            On Error GoTo 0

End Sub

merci de vos lumières

chb44

bonjour

l'ajout du code fonctionne bien !! merci