Vba Casse Nom (Prénom) vers NOM (Pénom)

Bonjour,
Pas si simple.
Ce code transforme la cellule active comme tu le souhaites et place le résultat dans la cellule voisine (à droite) :

Option Explicit  
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç"  
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc"  

Sub test()  
Dim Chaine() As String  
Chaine = Split(ActiveCell.Value, " (")  
ActiveCell.Offset(0, 1).Value = sansAccents(UCase(Chaine(0))) & " (" & Chaine(1)  
End Sub  

'trouvée ici (toujours afficher ces sources!)   
Private Function sansAccents(ByRef Chaine As String) As String
Dim i As Integer
Dim lettre As String
    sansAccents = Chaine
    For i = 1 To Len(accent)
    lettre = Mid(accent, i, 1)
    If InStr(sansAccents, lettre) > 0 Then
        sansAccents = Replace(sansAccents, lettre, Mid(noAccent, i, 1))
    End If
Next i
End Function

Lancer la macro appelée "test"
Cordialement,
Franck P

Merci pour ta réponse.
Je viens de tester, cela fonctionne.
Un seul problème, le script fonctionne seulement sur 1 cellule, mais pas sur la sélection dans la colonne.
Et si je peux abuser, est ce que l'inverse est possible : NOM (Prénom) vers Nom (Prénom), sans le problème des accents bien entendu.

En tout cas, merci pour ton aide qui m'est d'un grand secours et de la rapidité de ta réponse

Génial.

Mais j'ai encore un problème, c'est de ma faute, je n'ai pas donné tous les éléments. Désolé
Dans une cellule, il peut y avoir plusieurs noms séparés par des virgule espace
Ex : Bouquet (Brigitte), Madoui (Mohamed), Nivolle (Patrick)
Avec le test, cela donne ceci : BOUQUET (Brigitte), Madoui

Pour essayer de comprendre, dans ta formule,
Chaine = Split(Cel.Value, " (")
permet de séparer la cellule avec comme séparateur espace(

Cel.Offset(0, 1).Value = sansAccents(UCase(Chaine(0))) & " (" & Chaine(1)
permet d'appliquer sur ce qui est avant ( la formule sans accent
puis de refusionner la cellule

Chaine = Split(Cel.Offset(0, 1).Value, " (")
Permet de faire le deuxième traitement

Cel.Offset(0, 2).Value = WorksheetFunction.Proper(Chaine(0)) & " (" & Chaine(1)
la formule WorksheetFunction.Proper applique a ce qui se trouve avant ( une fonction 1ère lettre de chaque mot en majuscule

Par contre je n'arrive pas à voir où tu dis de mettre les caractère en majuscule. Je pense que c'est dans la fonction sansAccents

Je te remercie vivement pour ton travail, tes explications et ta rapidité.
Cela va me permettre de travailler de façon efficace sur ce fichier.
En outre, cela me permet d'approfondir mes connaissances dans la création de script.

Milles merci

Merci pour tes liens. Même si je ne compte pas pour l'instant me lancer dans ce langage, cela va me permettre de mieux comprendre les scripts que j'utilise et de les modifier (un peu!) si j'en ai le besoin.

Par contre, je viens de regarder mon fichier à transformer, et le fait d'éclater les cellules contenant plusieurs noms ne va pas être techniquement réalisable : Liste trop longue, et des transformations se feront chaque quinzaine.
Je travaille dans un centre de documentation. Je travaille dans un réseau d'échange de notices. Ce réseau vient de changer la manière de saisir les notices différentes de la notre (NOM (Prénom)). Pour notre part, nous préférons garder le format Nom (Prénom). Comme il y a échange régulier de notices, il faut que je trouve un traitement assez simple, sinon, nous devrons adopter les règles du réseau.
Je te mets en lien un exemple de notices à traiter. Ce traitement concernera les colonnes AU, AUCO, AS, et DENP.
http://www.cijoint.fr/cjlink.php?file=cj201106/cijOCaoSeH.xls
Merci de ton aide, même si cela n'est pas possible techniquement

J'ai un script qui permet de mettre le premier caractère se trouvant après une virgule espace en majuscule, je ne sais pas si cela peut aider.
Sub FirstMajVirgule()
' Permet la mise en majuscule de la première lettre d'une phrase
' et le reste en minuscule. Si la phrase contient un "." alors la
' première lettre du mot suivant sera en majuscule
Dim Plage As Range, Cellule As Range
On Error GoTo Erreur

' Affiche une fenêtre pour choisir la plage ou la cellule
Set Plage = Application.InputBox("Sélectionner une plage de cellules ou une cellule", "Sélection", Type:=8)

For Each Cellule In Plage
Cellule = F_Ucase(Cellule.Text)
Next Cellule

Erreur:
If Err.Number = 424 Then Exit Sub

End Sub

Function F_Ucase(Texte As String) As String
Dim Str1 As String, Str2 As String, TempStr As String
Dim i As Integer, LongStr As Integer
Dim iCar As Integer, icarLeft1 As Integer, icarLeft2 As Integer
Application.Volatile

' Sélection de la cellule
Str1 = Texte
Str1 = LCase(Str1)

'compte la longueur
LongStr = Len(Str1)

'Si la chaîne est vide, sortie
If LongStr = 0 Then Exit Function

'Si chaîne de longueur 1, alors saute à la fin de procédure
If LongStr = 1 Then GoTo PremierCaractere

' boucle à partir de la droite jusqu'au 2ème caractère
For i = LongStr To 3 Step -1
'sort le code du car actif
iCar = Asc(Mid(Str1, i, 1))

'sort le code du car à gauche du car actif
icarLeft1 = Asc(Mid(Str1, i - 1, 1))

' sort le code du 2ème car à gauche du car actif
icarLeft2 = Asc(Mid(Str1, i - 2, 1))

'Si le car actif n'est pas un des 3,alors
If Not (iCar = 10 Or iCar = 32 Or iCar = 46) Then
'Si le car à gauche est une virgule, alors passe le car actif en majuscule
If icarLeft1 = 44 Then
TempStr = UCase(Chr(iCar))
'si virgule et espace, alors majuscule
ElseIf icarLeft1 = 32 And icarLeft2 = 44 Then
TempStr = UCase(Chr(iCar))
'si retour chariot, alors majuscule
ElseIf icarLeft1 = 10 Then
TempStr = UCase(Chr(iCar))

'sinon le laisse en minuscule
Else
TempStr = Chr(iCar)
End If
Else
'sinon le laisse en minuscule
TempStr = Chr(iCar)
End If

'ajoute le car trouvé à la chaîne
Str2 = Str2 & TempStr
Next i

'gestion du caractère 2
SecondCaractere:
iCar = Asc(Mid(Str1, 2, 1))
icarLeft1 = Asc(Mid(Str1, 1, 1))
If Not (iCar = 10 Or iCar = 32 Or iCar = 46) Then
If icarLeft1 = 10 Or icarLeft1 = 46 Then
TempStr = UCase(Chr(iCar))
Else
TempStr = Chr(iCar)
End If
Else
TempStr = Chr(iCar)
End If
Str2 = Str2 & TempStr

'gestion du premier caractère
PremierCaractere:
iCar = Asc(Mid(Str1, 1, 1))
If Not (iCar = 10 Or iCar = 32 Or iCar = 46) Then
TempStr = UCase(Chr(iCar))
Else
TempStr = Chr(iCar)
End If

Str2 = Str2 & TempStr

'inversion de la chaîne trouvée
Str2 = StrReverse(Str2)

'renvoi de la valeur dans la cellule
F_Ucase = Str2
End Function

Salut,
Pas tout compris, mais bon essaye ceci quand même :

Option Explicit
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc"

Sub ChangerLeNomEnMajuscules()
Dim ChaineVirg() As String, ChaineParent() As String
Dim Result As String
Dim Cel As Range
Dim i As Integer

For Each Cel In Selection
    If InStr(Cel.Value, ",") > 0 Then
        ChaineVirg = Split(Cel.Value, ",")
    ElseIf Cel.Value <> "" Then
        ReDim ChaineVirg(0)
        ChaineVirg(0) = Cel.Value
    ElseIf Cel.Value = "" Then
        Result = ""
        GoTo Suite
    End If
    On Error Resume Next
    For i = 0 To UBound(ChaineVirg)
        If InStr(ChaineVirg(i), " (") > 0 Then
            ChaineParent = Split(Trim(ChaineVirg(i)), " (")
            Result = Result & sansAccents(UCase(ChaineParent(0))) & " (" & ChaineParent(1) & " ,"
        Else
            Result = Result & ChaineVirg(i) & " ,"
        End If
    Next
    Cel.Value = Left(Result, Len(Result) - 2)
    Result = ""
Suite:
Next
End Sub

Sub ChangerLeNomEnNomPropre()
Dim ChaineVirg() As String, ChaineParent() As String
Dim Result As String
Dim Cel As Range
Dim i As Integer

For Each Cel In Selection
    If InStr(Cel.Value, ",") > 0 Then
        ChaineVirg = Split(Cel.Value, ",")
    ElseIf Cel.Value <> "" Then
        ReDim ChaineVirg(0)
        ChaineVirg(0) = Cel.Value
    ElseIf Cel.Value = "" Then
        Result = ""
        GoTo suivant
    End If
    On Error Resume Next
    For i = 0 To UBound(ChaineVirg)
        If InStr(ChaineVirg(i), " (") > 0 Then
            ChaineParent = Split(Trim(ChaineVirg(i)), " (")
            Result = Result & WorksheetFunction.Proper(ChaineParent(0)) & " (" & ChaineParent(1) & " ,"
        Else
            Result = Result & ChaineVirg(i) & " ,"
        End If
    Next
    Cel.Value = Left(Result, Len(Result) - 2)
    Result = ""
suivant:
Next
End Sub

Private Function sansAccents(ByRef Chaine As String) As String
Dim i As Integer
Dim lettre As String
    sansAccents = Chaine
    For i = 1 To Len(accent)
    lettre = Mid(accent, i, 1)
    If InStr(sansAccents, lettre) > 0 Then
        sansAccents = Replace(sansAccents, lettre, Mid(noAccent, i, 1))
    End If
Next i
End Function

Je ne sais pas quoi te répondre, c'est exactement ce qu'il me fallait.
Juste une erreur au niveau de la syntaxe pour les cellules avec plusieurs noms.
Mais je pense pouvoir trouver où est le problème.
Vraiment génial

Dans le script : Bouquet (Brigitte) ,Madoui (Mohamed) ,Nivolle (Patrick)
Résultat voulu : Bouquet (Brigitte), Madoui (Mohamed), Nivolle (Patrick)