PONE MAYUSCULAS AL RANGO ENTRE AYD

¡ Hola !
Por favor necesito ayuda, tengo un formulario con determinados campos, pero ete aqui que necesito que los rangos ("A1:d5000") cuando reciban texto si esta en minuscula lo pase a mayuscula. intente con este codigo que encontre, pero se activa cada vez que cambio de celda:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set rgColA = Range("B1:h1000")
Dim rg As Range
For Each rg In rgColA.Cells
rg.Value = UCase(rg.Text)
Next
End Sub

podrian ayudarme, soy nuevo hoy me registre. muchas gracias.