XL 2016 Recherchev + récup commentaire

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

brouersa

XLDnaute Nouveau
Bonjour à tou(te)s,

Je souhaiterais pouvoir utiliser une VBA basée sur recherchev MAIS qui en plus copie le commentaire de la cellule initialement trouvée.
Donc autrement dit, je fais une recherchev "classique" et si la source contient un commentaire attaché je souhaite qu'il soit attaché tel quel au résultat de la recherchev.
Merci 1000 fois pour votre aide.
Excellentes fêtes de fin d'année à vous !
Alain
 

Pièces jointes

Bonjour,

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([A2:A10], Target) Is Nothing And Target.Count = 1 Then
     p = Application.Match(Target, Application.Index([Data], , 1), 0)
     If Not IsError(p) Then Sheets("BD").Range("data").Cells(p, 2).Copy Target.Offset(, 2)
  End If
End Sub

Private Sub Worksheet_Activate() ' pour maj si changement dans la BD
  Application.ScreenUpdating = False
  For Each c In [A2:A10]
     p = Application.Match(c, Application.Index([Data], , 1), 0)
     If Not IsError(p) Then Sheets("BD").Range("data").Cells(p, 2).Copy c.Offset(, 2)
   Next c
   Application.ScreenUpdating = True
End Sub



Boisgontier
 

Pièces jointes

Dernière édition:
Bonjour brouersa, salut JB (à la minute près),

Copier un commentaire nécessite du VBA.

Voyez le fichier joint et cette macro dans le code de Feuille destination (clic droit sur l'onglet et Visualiser le code) :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, i As Variant
Set r = Intersect(Target, UsedRange.Columns(1))
If r Is Nothing Then Exit Sub
With Feuil2 'CodeName Feuille source
    For Each r In r 'si entrées /effacements multiples
        i = Application.Match(r, .Columns(1), 0)
        If IsNumeric(i) Then .Cells(i, 2).Copy r(1, 3) Else r(1, 3) = "" 'copier-coller
    Next
End With
End Sub
A+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour