Sub AnalyseComments()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, Tbl As Table, Rng As Range, r As Long
Set DocSrc = ActiveDocument
'Create a new document for the comments
Set DocTgt = Documents.Add
'Insert a 4-column table for the comments
With DocTgt
  .Content = ""
  Set Tbl = .Tables.Add(Range:=.Range, NumRows:=DocSrc.Comments.Count + 1, NumColumns:=4)
  With Tbl
    With .Rows(1)
      .Range.Font.Bold = True
      .Cells(1).Range.Text = "Page"
      .Cells(2).Range.Text = "Comment scope"
      .Cells(3).Range.Text = "Comment text"
      .Cells(4).Range.Text = "Author"
    End With
    'Get info from each comment from DocSrc and insert in table
    For r = 1 To .Rows.Count
      With .Rows(r + 1)
        'Page number
        .Cells(1).Range.Text = DocSrc.Comments(r).Scope.Information(wdActiveEndPageNumber)
        'The text marked by the comment
        Set Rng = .Cells(2).Range
        With Rng
          .End = .End - 1
          .FormattedText = DocSrc.Comments(r).Scope.FormattedText
        End With
        'The comment itself
        Set Rng = .Cells(3).Range
        With Rng
          .End = .End - 1
          .FormattedText = DocSrc.Comments(r).Range.FormattedText
        End With
        'The comment author
        .Cells(4).Range.Text = DocSrc.Comments(r).Author
      End With
    Next
  End With
  .Activate
End With
Set DocSrc = Nothing: Set DocTgt = Nothing: Set Tbl = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
MsgBox "Finished creating comments document."
End Sub