formule separer nom prenom

Sub NomsPrenoms()
With ActiveSheet
    Dim T: T = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
    Dim i As Integer, nb As Integer, j As Integer
    Dim un As Variant, res As Variant
    nb = UBound(T)
    ReDim res(1 To nb, 1 To 2)
    For i = 1 To nb
     un = Split(Trim(Replace(Replace(T(i, 1), "M.", ""), "Mme", "")), " ")
     For j = 0 To UBound(un)
        If UCase(un(j)) = un(j) Then
            res(i, 2) = res(i, 2) & " " & un(j)
        Else
            res(i, 1) = res(i, 1) & " " & un(j)
        End If
     Next
      res(i, 1) = Trim(res(i, 1))
      res(i, 2) = Trim(res(i, 2))
      
    Next
    .Range("F2:G2").Resize(nb).Value = res
    End With
End Sub

=GAUCHE(SUBSTITUE(SUBSTITUE(SUBSTITUE(A2;"M. ";"");"Mme ";"");"Mle ";"");EQUIV(VRAI;EXACT(STXT(SUBSTITUE(SUBSTITUE(SUBSTITUE(A2;"M. ";"");"Mme ";"");"Mle ";"");LIGNE($1:$255);3);MAJUSCULE(STXT(SUBSTITUE(SUBSTITUE(SUBSTITUE(A2;"M. ";"");"Mme ";"");"Mle ";"");LIGNE($1:$255);3)));0))

=STXT(SUBSTITUE(SUBSTITUE(SUBSTITUE(A2;"M. ";"");"Mme ";"");"Mle ";"");EQUIV(VRAI;EXACT(STXT(SUBSTITUE(SUBSTITUE(SUBSTITUE(A2;"M. ";"");"Mme ";"");"Mle ";"");LIGNE($1:$255);3);MAJUSCULE(STXT(SUBSTITUE(SUBSTITUE(SUBSTITUE(A2;"M. ";"");"Mme ";"");"Mle ";"");LIGNE($1:$255);3)));0)+1;999)

Function Prénom(ATrouver As String) As String
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "(?!M\.)(?!Mme)(?!Mlle)([A-Z]['a-zàâéèëêïîöôüûy]+-* *)+"
        If .test(ATrouver) Then
    Prénom = .Execute(ATrouver)(0)
    End If
End With
End Function

Function Nom(ATrouver As String) As String
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "(?!M\.)(?!Mme)(?!Mlle)(['A-Z]{2,}-* *)+"
        If .test(ATrouver) Then
    Nom = .Execute(ATrouver)(0)
    End If
End With
End Function

Public Function sansAccents(txt As String) As String
Application.Volatile
For i% = 1 To Len(txt)
    Select Case Mid(txt, i, 1)
        Case Chr(192) To Chr(197), Chr(224) To Chr(229)
            char = "A"
        Case Chr(232) To Chr(235), Chr(200) To Chr(203)
            char = "E"
        Case "í", "ì", "î", "ï", "Í", "Ì", "Î", "Ï"
            char = "I"
        Case "ó", "ò", "ô", "ö", "õ", "Ó", "Ò", "Ô", "Ö", "Õ", Chr(248)
            char = "O"
        Case "ú", "ù", "û", "ü", "Ú", "Ù", "Û", "Ü"
            char = "U"
        Case "ÿ", "ý", Chr(221), Chr(159)
            char = "Y"
        Case "ñ", "Ñ"
            char = "N"
        Case "ç", Chr(199)
            char = "C"
        Case Chr(230), Chr(198)
            char = "AE"
        Case Chr(138)
            char = "S"
        Case Chr(140), Chr(156)
            char = "OE"
    Case Else
        char = UCase(Mid(txt, i, 1))
    End Select
    laChaine = laChaine & char
Next i
sansAccents = Trim(laChaine)
End Function

Sub travdem()
Dim Cellule As Range
Dim Nomfeuille1 As String
Dim Col As String
Dim data1 As String
Dim pos As Integer
Dim Civilite As String
Dim prenom As String
Dim nom As String
Dim pre As Boolean
Dim i As Long
'parametre
' pour boucler sur la colonne 1
Nomfeuille1 = "Nom Prénom"
Col = "A"
With Sheets(Nomfeuille1)
 For Each Cellule In .Range(Col & "2:" & Col & .Range(Col & .Rows.Count).End(xlUp).Row)
 pos = InStr(2, Cellule, " ")
   Civilite = Trim(Mid(Cellule, 1, pos))
data1 = Trim(Replace(Cellule, Civilite, ""))
 
 pos = 0
 Do
    pre = False
     pos = InStr(pos + 1, data1, " ")
     For i = pos To Len(data1)
        If Asc(Mid(data1, i, 1)) > Asc("a") - 1 Then
            pre = True
            Exit For
        End If
    Next i
' si pre = false alors l'espace est le séparateur entre nom et prenom
    If pre = False Then Exit Do
    
Loop
nom = Trim(Mid(data1, pos, 1000))
prenom = Trim(Replace(data1, nom, ""))
.Range("b" & Cellule.Row) = Civilite
.Range("c" & Cellule.Row) = prenom
.Range("d" & Cellule.Row) = nom


Next Cellule

End With
End Sub

Public Function Prenom(zone As Range)
Application.Volatile
Dim tmpStr() As String, i As Long
    Prenom = ""
    tmpStr = Split(zone(1, 1).Text, " ")
    For i = LBound(tmpStr) To UBound(tmpStr)
        If WorksheetFunction.Proper(tmpStr(i)) = tmpStr(i) Then Prenom = Prenom & tmpStr(i) & " "
    Next i
    If Len(Prenom) <> 0 Then Prenom = Left(Prenom, Len(Prenom) - 1)
End Function

Public Function Nom(zone As Range)
Application.Volatile
Dim tmpStr() As String, i As Long
    Nom = ""
    tmpStr = Split(zone(1, 1).Text, " ")
    For i = LBound(tmpStr) To UBound(tmpStr)
        If UCase(tmpStr(i)) = tmpStr(i) Then Nom = Nom & tmpStr(i) & " "
    Next i
    If Len(Nom) <> 0 Then Nom = Left(Nom, Len(Nom) - 1)
End Function