Option Explicit
Sub CommentsSummary()
' constants
Const ksWSComments = "Comments"
' declarations
Dim wsC As Worksheet
Dim I As Long, J As Long, A As String, C As Range
' start
Set wsC = Worksheets(ksWSComments)
With wsC
Range(.Rows(2), .Rows(.Rows.Count)).ClearContents
End With
' process
With wsC
J = 1
For I = 1 To ThisWorkbook.Worksheets.Count
If ThisWorkbook.Worksheets(I).Name <> ksWSComments Then
For Each C In ThisWorkbook.Worksheets(I).UsedRange
If Not C.Comment Is Nothing Then
J = J + 1
.Cells(J, 1).Value = C.Parent.Name
.Cells(J, 2).Value = C.Address(False, False)
.Cells(J, 3).Value = C.Comment.Author
.Cells(J, 4).Value = C.Comment.Text
End If
Next C
End If
Next I
End With
' end
With wsC
.Activate
.Range("A1").Select
.Range("A2").Select
End With
Set wsC = Nothing
Beep
End Sub