Trier colonne emails avec beaucoup de critères

Sub TesterAdresses()
Dim c As Range
Dim sh As Worksheet
Dim RegExp As Object
Dim oldCalcMode As XlCalculation
'pour aller plus rapidement
oldCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Set RegExp = CreateObject("vbscript.regexp")
    RegExp.Global = True
    RegExp.Pattern = "^([a-zA-Z0-9_\.\-])+@(([a-zA-Z0-9\-])+\.)+(com|org|net|gov|biz|info|name|aero|fr|be|co.uk|it|es|de|info)+$"
    With ActiveSheet
        For Each c In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
            Debug.Print c.Row
            If RegExp.Execute(c).Count = 0 Then c = "AAAAA Mauvaie adresse: " & c
        Next
    End With
    
'Rétablir les paramètres application
Application.Calculation = oldCalcMode
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub