Souligner et mettre en Rouge les lettres qui sont en majuscules dans du texte

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    For n = 1 To Len(Target.Value)
    c = Asc(Mid(Target.Value, n, 1))
        If c >= 65 And c <= 90 Then
           With ActiveCell.Characters(Start:=n, Length:=1).Font
                .Underline = xlUnderlineStyleSingle
                .Color = -16776961
            End With
        End If
    Next n

End Sub