Extract UPPER CASE words.

Based on your example:

Sub UpperONLY()
Dim LR As Long, cell As Range, RNG As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set RNG = Range("A1:A" & LR)
    
    For Each cell In RNG
        If cell = UCase(cell) Then cell.Copy Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
    Next cell

Set RNG = Nothing
End Sub