Sub MajMin()
Dim cel As Range, x$, txt1$, txt2$
Set cel = [A1] 'à adapter
For i = 1 To Len(cel)
x = Mid(cel, i, 1)
If x = LCase(x) Then txt1 = txt1 & x Else txt2 = txt2 & x
Next
cel = txt1
cel.Offset(1) = txt2
End Sub
Sub MajMin()
Dim cel As Range, x$, txt1$, txt2$
Set cel = [A1] 'à adapter
For i = 1 To Len(cel)
x = Mid(cel, i, 1)
If i = 1 Or x = LCase(x) Then txt1 = txt1 & x Else txt2 = txt2 & x
Next
cel = txt1
cel.Offset(1) = txt2
End Sub
Option Explicit
Sub Tst()
Dim LastRow As Long, i As Long, j As Long
Dim L As Long, s As String, c As String * 1
Dim cpt As Long, s1 As String, s2 As String
LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
L = Len(Feuil1.Range("A" & i))
cpt = 0
s = Feuil1.Range("A" & i)
For j = 1 To L
c = Mid$(s, j, 1)
If c = UCase$(c) Then cpt = cpt + 1
If cpt = 2 Then
s1 = Left$(s, j - 1)
s2 = Right$(s, L - j + 1)
Exit For
End If
Next j
Feuil1.Range("B" & i) = s1
Feuil1.Range("C" & i) = s2
Next i
End Sub
Sub MajMin()
Dim cel As Range, x$, y$, txt1$, txt2$
Set cel = [A1] 'à adapter
For i = 1 To Len(cel)
x = Mid(cel, i, 1)
y = Mid(cel, i + 1, 1)
If x = LCase(x) Or y = LCase(y) And y <> "" Then _
txt1 = txt1 & x Else txt2 = txt2 & x
Next
cel = txt1
cel.Offset(1) = txt2
End Sub
Sub Tst2()
Dim LastRow As Long, i As Long, j As Long
Dim L As Long, s As String, c As String * 1
Dim s1 As String, s2 As String
LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
L = Len(Feuil1.Range("A" & i))
s = Feuil1.Range("A" & i)
For j = L To 1 Step -1
c = Mid$(s, j, 1)
If c = LCase$(c) Then
s1 = Left$(s, j)
s2 = Right$(s, L - j)
Exit For
End If
Next j
Feuil1.Range("B" & i) = s1
Feuil1.Range("C" & i) = s2
Next i
End Sub