How to Extract Cell "Comments"

Maybe like this:

Sub ListComments()
    Dim wksSrc  As Worksheet
    Dim wksCom  As Worksheet
    Dim rCom    As Excel.Range
    Dim rInp    As Excel.Range
    Dim rOut    As Excel.Range

    Set wksSrc = ActiveSheet

    On Error Resume Next
    Set wksCom = Worksheets("Comments")
    If Err Then
        Set wksCom = Worksheets.Add(After:=Sheets(Sheets.Count))
        wks.Name = "Comments"
    End If
    wksCom.Cells.ClearContents

    Set rCom = wksSrc.Cells.SpecialCells(xlCellTypeComments)
    If rCom Is Nothing Then Exit Sub
    On Error GoTo 0

    Set rOut = wksCom.Range("A1")
    For Each rInp In rCom
        rOut(1, 1) = rInp.Address(False, False)
        rOut(1, 2) = rInp.Comment.Text
        Set rOut = rOut.Offset(1)
    Next rInp
End Sub