Sub test()
Dim c As Range, m As String, i As Byte
For Each c In Range("A1:A" & Range("A65536").End(xlUp).Row)
m = ""
With c
For i = 1 To .Characters.Count
If UCase(.Characters(i, 1).Text) = .Characters(i, 1).Text Then m = m & .Characters(i, 1).Text
If Not UCase(.Characters(i, 1).Text) = .Characters(i, 1).Text Then
m = ""
Exit For
End If
Next i
End With
c.Offset(0, 1).Value = m
Next c
End Sub