1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
| Option Explicit
Public Sub majCommentaires()
Dim curCell As Range, lastLineSearch As Integer, i As Integer
ThisWorkbook.Sheets("Suivi").Columns(3).ClearComments
Set curCell = ThisWorkbook.Sheets("Suivi").Range("C2")
With ThisWorkbook.Sheets("Liste question")
lastLineSearch = .Cells(.Rows.Count, 1).End(xlUp).Row
While curCell.Value <> vbNullString
For i = 3 To lastLineSearch
If .Cells(i, 1).Value = curCell.Text Then
If curCell.comment Is Nothing Then curCell.AddComment
curCell.comment.Text Text:=.Cells(i, 2).Value
End If
Next i
Set curCell = curCell.Offset(1, 0)
Wend
End With
End Sub |
Partager