Macro Trop lente ! Améliorer sa rapidité

Bonjour à tous !

Je souhaiterais améliorer la rapidité de cette macro qui est bien trop lente... Avez vous des suggestions ?

Dim Lig As Long
Application.ScreenUpdating = False

With Sheets("RENCONTRE") 'A adapter
    For Lig = 3 To .Range("A" & Rows.Count).End(xlUp).Row
        If .Range("A" & Lig) Like "*.*" Then .Range("A" & Lig) = Split(.Range("A" & Lig), ". ")(1)
        .Range("A" & Lig) = UCase(.Range("A" & Lig))
    Next
End With

bonjour,

une proposition

Sub test()

    Dim Lig As Long
    Application.ScreenUpdating = False

    With Sheets("RENCONTRE") 'A adapter
        t = .Range("A3:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        For i = LBound(t) To UBound(t)
            s = InStr(t(i, 1), ". ")
            If s > 0 Then t(i, 1) = Mid(t(i, 1), s + 2)
            t(i, 1) = UCase(t(i, 1))
        Next
        Range("A3").Resize(UBound(t), 1) = t
    End With

End Sub

Super ! C'est instantané. Merci a toi.