Dim R As Range, aTx, cTx As String
'-------- Links drei neue Spalten für die Ausgabe einfügen -------
Range("A1").EntireColumn.Insert
Range("A1").EntireColumn.Insert
Range("A1").EntireColumn.Insert
'-------- Alle Zellen mit Kommentar verarbeiten ------------------
For Each R In ActiveSheet.Cells.SpecialCells(xlCellTypeComments)
'-------- Eingabe aus Special Zellen vom Typ xlCellTypeComments --
    With R.Comment
        cTx = .Text
        aTx = .Author
    End With
'-------- Verarbeitung der gelesenen Texte -----------------------
    cTx = Replace(cTx, vbLf, " ") ' Entfernt Zeilenumbrüche
    If cTx Like aTx & ":*" Then   ' Wenn "Autor:" im Kommentaran=
        '                           fang steht wird dieser ent=
        '                           fernt
        cTx = Right(cTx, Len(cTx) - Len(aTx) - 1)
    End If
'-------- Ausgabe in die neuen Spalten ---------------------------
    With ActiveSheet
        .Cells(R.Row, 1) = Replace(R.Address, "$", "") ' Adresse
        .Cells(R.Row, 2) = aTx                         ' Autor
        .Cells(R.Row, 3) = Trim(cTx)                   ' Kommentar
    End With
    'Kommentar entfernen
    R.ClearComments
Next R