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