Macro majuscule pas au point

Bonsoir a toutes et tous, forum bonsoir

Reste plus qu'a faire fonctionner cette macro qui marche pas bien et qui de plus très lente quand la liste s'allonge, si on pouvais m'arranger ca. ca me dépannerai bien.

voyez svp le fichier joint c'est plus clair enfin j'espere.

Bon courage ca fait deux heures que je suis dessus et snif snif

Bonne soirée a vous et merci d'avance

Raymond

essaie ce code:

'*** CODE PREMIERE LETTRE (MAJUSCULE GRAS et ROUGE) A PARTIR DE "A4:A1300" SUR TOUTE LA COLONNE "A"
Sub Majusc()
Dim Lg%, Cel As Range
Dim i As Integer
Lg = Range("A1300").End(xlUp).Row
Application.ScreenUpdating = False

With Range("a4:a" & Lg).Font
.Name = "Calibri"
.ColorIndex = 1
.Size = 9
End With

For Each Cel In Range("a4:a" & Lg)
    For i = 1 To Len(Cel.Value)
        If Not IsNumeric(Mid(Cel, i, 1)) And Not Mid(Cel, i, 1) = " " Then
           'Si on est rendu au point, quitte la boucle
           If Mid(Cel, i, 1) = "." Then Exit For
           Cel = Application.Proper(Cel)

            With Cel.Characters(Start:=i, Length:=1).Font
                .ColorIndex = 3
                .Bold = True
                .Size = 11
            End With

            Exit For
        End If
    Next i
Next Cel
End Sub

Bonjour a toutes et tous, forum

Bonjour Math

Merci de ta réponse c'est presque bon a part que la macro met toujours les autres lettres en majuscule

Regarde bien en colonne D le résultat souhaiter pour la colonne A, Mais merci c'est déja ca ca avance

Une bonne journée a tous le monde

Raymond

la fonction Proper met chaque debut de chaques mots en majuscule, faudrait changer de méthode, j'ai essayé avec des left et right:

Option Explicit
'*** CODE PREMIERE LETTRE (MAJUSCULE GRAS et ROUGE) A PARTIR DE "A4:A1300" SUR TOUTE LA COLONNE "A"
Sub Majusc()
Dim Lg%, Cel As Range
Dim i As Integer
Lg = Range("A1300").End(xlUp).Row
Application.ScreenUpdating = False

With Range("a4:a" & Lg).Font
.Name = "Calibri"
.ColorIndex = 1
.Size = 9
End With

For Each Cel In Range("a4:a" & Lg)
    For i = 1 To Len(Cel.Value)
        If Not IsNumeric(Mid(Cel, i, 1)) And Not Mid(Cel, i, 1) = " " Then
           'Si on est rendu au point, quitte la boucle
           If Mid(Cel, i, 1) = "." Then Exit For

            Cel = Left(Cel, i - 1) & UCase(Mid(Cel, i, 1)) & Right(Cel, Len(Cel) - i)

            With Cel.Characters(Start:=i, Length:=1).Font
                .ColorIndex = 3
                .Bold = True
                .Size = 11
            End With

            Exit For
        End If
    Next i
Next Cel
End Sub

Salut Math, forum

Merci bien pour la modification, je l'ai essayer c'est nickel chrome, ca marche comme je voulais.

encore un truc de résolu, j'ai presque fini ouf

Merci Math pour ton temps et ton savoir, je te souhaite une bonne fin d'après midi

ainsi qu'un bon W-end.

Raymond