Sauvegarder les commentaire sur excel a l'aide d'une macro

Sub ListeCommentaires()
    MaFeuille = ActiveSheet.Name
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Commentaires").Delete
    On Error GoTo 0
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Commentaires"
    Set Zone = Range("B3:M33")
    Ligne = 1
    For Each C In Sheets(MaFeuille).Comments
        If Not Intersect(Range(C.Parent.Address), Zone) Is Nothing Then
            Sheets("Commentaires").Cells(Ligne, 1) = C.Parent.Address
            Sheets("Commentaires").Cells(Ligne, 2) = C.Text
            Sheets("Commentaires").Cells(Ligne, 3) = IIf(IsDate(C.Parent), Format(C.Parent, "mm/dd/yyyy"), C.Parent)

            Ligne = Ligne + 1
        End If
    Next C
    Range("A1:C100").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
    Columns("B:B").Columns.AutoFit
End Sub