Columns("A:A").Select
Selection.Replace What:=" ", Replacement:=" & ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, t As String
Set r = Intersect(Target, [A:A], Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In r 'en cas d'entrées multiples
t = Application.Trim(Replace(r.Text, "&", "")) 'SUPPRESPACE
r = Replace(t, " ", " & ")
Next
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Deux prénom avec & entre les deux
Dim r As Range, t As String
Set r = Intersect(Target, [D:D], Me.UsedRange) ' colonne D
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In r 'en cas d'entrées multiples
t = Application.Trim(Replace(r.Text, "&", "")) 'SUPPRESPACE
r = Replace(t, " ", " & ")
Next
Application.EnableEvents = True
'Nom en Nom Propre
If Not Intersect(Target, [D3:D1000]) Is Nothing Then
Application.EnableEvents = False
Target.Value = Application.Evaluate("PROPER(""" & Target.Value & """)")
Application.EnableEvents = True
End If
End Sub
Target.Value = Application.Evaluate("PROPER(""" & Target.Value & """)")
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, t As String
Set r = Intersect(Target, [D:D], Me.UsedRange) 'colonne D
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In r 'en cas d'entrées multiples
t = Application.Trim(Replace(r.Text, "&", "")) 'SUPPRESPACE
r = Application.Proper(Replace(t, " ", " & "))
Next
Application.EnableEvents = True
End Sub