Sub ExtractComments()
Dim ExComment As Comment
Dim i As Integer
Dim ws As Worksheet
Dim CS As Worksheet
Set CS = ActiveSheet
If ActiveSheet.Comments.Count = 0 Then Exit Sub

For Each ws In Worksheets
  If ws.Name = "Comments" Then i = 1
Next ws

If i = 0 Then
  Set ws = Worksheets.Add(After:=ActiveSheet)
  ws.Name = "Comments"
Else: Set ws = Worksheets("Comments")
End If

For Each ExComment In CS.Comments
  ws.Range("A1").Value = "Comment In"
  ws.Range("B1").Value = "Comment By"
  ws.Range("C1").Value = "Comment"
  With ws.Range("A1:C1")
    .Font.Bold = True
    .Interior.Color = RGB(189, 215, 238)
    .Columns.ColumnWidth = 20
  End With
  If ws.Range("A2") = "" Then
    ws.Range("A2").Value = ExComment.Parent.Address
    ws.Range("B2").Value = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
    ws.Range("C2").Value = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
  Else
    ws.Range("A1").End(xlDown).Offset(1, 0) = ExComment.Parent.Address
    ws.Range("B1").End(xlDown).Offset(1, 0) = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
    ws.Range("C1").End(xlDown).Offset(1, 0) = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
  End If
Next ExComment
End Sub

ExComment.Parent.Address

Cells(1, ExComment.Parent.Column).Value

ws.Range("A2").Value = ExComment.Parent.End(xlUp).Value

If ws.Range("A2") = "" Then
      ws.Range("A2").Value = ExComment.Parent.End(xlUp).Value
      ws.Range("B2").Value = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
      ws.Range("C2").Value = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
    Else
      ws.Range("A1").End(xlDown).Offset(1, 0) = ExComment.Parent.End(xlUp).Value
      ws.Range("B1").End(xlDown).Offset(1, 0) = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
      ws.Range("C1").End(xlDown).Offset(1, 0) = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
    End If

...
Else: Set ws = Worksheets("Comments")
End If

Dim iRow As Long   ' you have a better control this way directly specifying the target cell

' header needs to written only once - out of loop

ws.Range("A1").Value = "Comment In"
ws.Range("B1").Value = "Comment By"
ws.Range("C1").Value = "Comment"

With ws.Range("A1:C1")
    .Font.Bold = True
    .Interior.Color = RGB(189, 215, 238)
    .Columns.ColumnWidth = 20
End With

iRow = 2        ' first empty row
For Each ExComment In CS.Comments
    ws.Cells(iRow, 1).Value = CS.Cells(1, ExComment.Parent.Column)  ' value in 1st row of column of comment
    ws.Cells(iRow, 2).Value = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
    ws.Cells(iRow, 3).Value = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
    iRow = iRow + 1
Next ExComment

End Sub

Sub ExtractComments()

Dim ExComment As Comment
Dim i As Long
Dim ws As Worksheet
Dim CS As Worksheet
Set CS = ActiveSheet
If ActiveSheet.Comments.Count = 0 Then Exit Sub

For Each ws In Worksheets
  If ws.Name = "Comments" Then i = 1
Next ws

If i = 0 Then
  Set ws = Worksheets.Add(After:=ActiveSheet)
  ws.Name = "Comments"
Else: Set ws = Worksheets("Comments")
End If

With ws
    .Range("A1").Value = "Comment In"
    .Range("B1").Value = "Comment By"
    .Range("C1").Value = "Comment"
    With .Range("A1:C1")
        .Font.Bold = True
        .Interior.Color = RGB(189, 215, 238)
        .Columns.ColumnWidth = 20
    End With
    For Each ExComment In CS.Comments
        .Range("A" & Rows.Count).End(xlUp)(2).Value = CS.Cells(1, ExComment.Parent.Column)
        .Range("B" & Rows.Count).End(xlUp)(2).Value = Left(ExComment.Text, InStr(1, ExComment.Text, ":") - 1)
        .Range("C" & Rows.Count).End(xlUp)(2).Value = Right(ExComment.Text, Len(ExComment.Text) - InStr(1, ExComment.Text, ":"))
    Next ExComment
End With

End Sub