Sub ConcatComments()
Dim P As Range, ncol%, i&, t$, j%, n&
Application.ScreenUpdating = False
With Sheets("Feuil1")
Set P = Intersect(.UsedRange, .[J:V])
If P Is Nothing Then Exit Sub
With Intersect(P.EntireRow, .[B:B])
.ClearContents: .ClearComments 'RAZ
End With
End With
ncol = P.Columns.Count
For i = 1 To P.Rows.Count
t = "" 'RAZ
For j = 1 To ncol
If Not P(i, j).Comment Is Nothing Then t = t & vbLf & P(i, j).Comment.Text
Next j
With P(i, 1).EntireRow.Cells(2) 'en colonne B
If t <> "" Then
n = n + 1
.Value = "Comment" & n
With .AddComment(Mid(t, 2)).Shape
.Fill.ForeColor.RGB = RGB(0, 112, 192) 'remplissage bleu
With .TextFrame.Characters.Font
.Size = 14 'taille de la police
.Bold = True 'gras
.ColorIndex = 2 'blanc
End With
.TextFrame.AutoSize = True
End With
End If
End With
Next i
End Sub