Supprimer premiereS majuscules d'une cellule

Option Explicit
Private Sub CommandButton1_Click()
Dim LTLigne As Long
Dim VTPlage As Variant
Dim TSFin() As String
'-------------------------------------------------------------
VTPlage = Range("A2:" & Cells(Rows.Count, 1).End(xlUp).Address).Value
'-------------------------------------------------------------
ReDim TSFin(1 To UBound(VTPlage, 1), 1 To 2)
For LTLigne = LBound(VTPlage, 1) To UBound(VTPlage, 1)
    TSFin(LTLigne, 1) = LCase(VTPlage(LTLigne, 1))
Next LTLigne
Columns("B").ClearContents
Range("B2").Resize(UBound(TSFin, 1), 1) = TSFin
End Sub

Function ExtraitMinuscule(MonTexte As String) As String
Dim Matches, Match
Application.Volatile
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "[^A-Z]"
    Set Matches = .Execute(MonTexte)
    For Each Match In Matches
        ExtraitMinuscule = ExtraitMinuscule & Match
    Next
End With
End Function

.Pattern = "[^A-ZÂÄÀÉÈÊËÎÏÔÖÛÙ]"

Function ExtraitMinuscule2(MonTexte As String) As String
Dim Matches, Match
Application.Volatile
With CreateObject("vbscript.regexp")
    .Global = False
    .Pattern = "([a-z0-9_\.\-])+@(([a-z0-9\-])+\.)+(com|org|net|gov|biz|info|name|aero|fr|be|co.uk|it|es|de|info)+"
    Set Matches = .Execute(MonTexte)
    If Matches.Count = 1 Then ExtraitMinuscule2 = Matches(0)
End With
End Function