Sub DeplaceMajuscules()
Dim rg As Range, c As Range
Dim s As String, i As Integer
Dim bMaj As Boolean
Set rg = [A1:A100] 'Définir la plage ici ***
Application.ScreenUpdating = False
For Each c In rg
s = Replace(c.Text, " ", "")
bMaj = True
For i = 1 To Len(s)
If Asc(Mid(s, i, 1)) < 65 Or Asc(Mid(s, i, 1)) > 90 Then bMaj = False: GoTo 2
Next i
c.Offset(0, 1) = c
c = ""
2: Next c
Application.ScreenUpdating = True
End Sub