Correction écriture

[boulou]

Bonjour à tous.

Comment corriger cette instruction pour qu'il ne s'agisse plus d'un simple copié/collé mais, d'une transposition de telle sorte que le commentaire associé à la cellule copiée soit également transféré en "H45".

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cellule As Range
If Target.Address <> "$M$32" Then Exit Sub
If Target.Value > 0 And Target.Value < 205 Then
Set Cellule = Range("AB1:AB205").Find(Target.Value, lookat:=xlWhole)
If Not Cellule Is Nothing Then
Range("D45") = Cellule.Offset(0, -1).Value
Range("H45") = Cellule.Offset(0, 1).ValueEnd If
End If
End Sub

Merci à vous.

 

[Fred0o]

Re : Correction écriture

bonjour boulou,

Voici un code qui fonctionne si le commentaire en H45 est déjà créé (mêmme si il ne contient rien) :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cellule As Range
    If Target.Address <> "$M$32" Then Exit Sub
    If Target.Value > 0 And Target.Value < 205 Then
        Set Cellule = Range("AB1:AB205").Find(Target.Value, Lookat:=xlWhole)
        If Not Cellule Is Nothing Then
            Application.EnableEvents = False
            Range("D45") = Cellule.Offset(0, -1).Value
            Range("H45") = Cellule.Offset(0, 1).Value
            Range("H45").Comment.Text Text:=Cellule.Offset(0, 1).Comment.Text
            Application.EnableEvents = True
        End If
    End If
End Sub

A+

 

[Hippolite]

Re : Correction écriture

Bonjour à tous,
Variante :

    Cellule.Offset(0, 1).Copy
    Range("H45").PasteSpecial Paste:=xlPasteComments

a+

 

[boulou]

Re : Correction écriture

Merci à vous, c'est parfait.