Cómo asignar a un Rango la función Worksheet_Change?

También es difícil seguir el hilo de un código tan largo que además se ve todo compactado.

Así que te voy a dar algunas pautas para que lo ajustes y luego me envíes lo que resultó si aún necesitas alguna ayuda.

Si se tiene que considerar cambios en varias celdas hay más de 1 método, todo dependerá de qué hacer en cada celda.

Lo primero es descartar cambios en otros rangos:

Private Sub Worksheet_Change(ByVal Target As Range)

if intersect(Target, Range("V2:AQ2")) is nothing then exit sub

'a continuación todas las instrucciones que van a ser las mismas para todas las celdas del rango

'..........................

'Si hay instrucciones que dependen de la celda modificada se evalúa cada una con Select

Select case Target.Address

Case is = "$V$2"

'instrucciones para v2

Case is = "$W$2"

'así con cada celda que tenga sus propias instrucciones

End Select

End Sub

IMPORTANTE: considerando que estás en el evento CHANGE (cambios en celda) tenés que tener presente que si movés un dato a alguna celda de este rango SE VUELVE A EJECUTAR... hay que impedirlo con algunas instrucciones que llegado el momento te lo indicaré. Por ahora prepará el código y tratá de que al copiarlo se vea legible.

Gracias por la respuesta Elsa.

Resumiendo el código seria asi...

Modifico el valor de la celda V2 y tiene que rellenar con ese mismo valor (Vacaciones, Dia Libre, Licencia y Borrar) todas las celdas que cumplan con la condición de igualdad Range("U" & Trim(Str(i%))).Value = Sheets("Usuarios").Range("I4"). Esta acción debe aplicar a todo el rango ("V2:AQ2").

Por ejemplo para el valor Licencia.

If Target.Address = "$V$2" Then
If Target.Value = "Licencia" Then

<><>Desprotege la hoja<><>

Sheets("Imputaciones").Select
ActiveSheet.Unprotect "123"
<><>Revisa desde la fila 5 hacia abajo hasta encontrar vacío<><>
i% = 5
Do While ActiveSheet.Range("U" & Trim(Str(i%))).Value <> ""

<><>Cuando se cumple la igualdad Relleno el rango con el valor de V2<><>

If ActiveSheet.Range("U" & Trim(Str(i%))).Value = Sheets("Usuarios").Range("I4").Value Then
ActiveSheet.Range("V" & Trim(Str(i%))).Value = "Licencia"

<><>Protege las celdas<><>
ActiveSheet.Range("V" & Trim(Str(i%))).Select
Selection.Locked = True
Selection.FormulaHidden = False
End If
i% = i% + 1
Loop

<><>Protege la hoja<><>
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, password:="123"
End If

<><>Luego lo mismo para Vacaciones, Dia Libre y Borrar<><>

El problemas es replicarlo para todas las celdas restantes del rango ("V2:AQ2")
If Target.Address = "$W$2"
If Target.Address = "$X$2"
If Target.Address = "$Y$2", etc,etc...

Repetí el mismo código hasta llegar a AQ2 pero me dio error ya que el código es muy largo.

Entonces ahora aplicá los ajustes que te comenté en respuesta anterior:

Primero obviar los cambios fuera de ese rango

Luego si las instrucciones son las mismas para todos los target tené cuidado con esta línea, quizás tengas que evaluar cuál es el target en este momento, con el Select como te indiqué o con un If:

Sheets("Usuarios").Range("I4").Value

Cuando lo tengas armado escribime nuevamente si algo no queda resuelto.

Sdos

Elsa

Ya lo solucione...

Tenia que entregarle a ua variable la intentar de la celda y asi evito crear el mismo código para todo el rango.

Y donde se debe llenar os campos use la función ActiveCell.Offset...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dirección As String

lugar = ActiveCell.Address

If Intersect(Target, Range("V2:AQ2")) Is Nothing Then Exit Sub
Select Case Target.Address

Case Is = lugar
If Target.Value = "Licencia" Then
Sheets("Imputaciones").Select
ActiveSheet.Unprotect "123"

i% = 5
Do While ActiveSheet.Range("U" & Trim(Str(i%))).Value <> ""
If ActiveSheet.Range("U" & Trim(Str(i%))).Value = Sheets("Usuarios").Range("I4").Value Then

ActiveCell.Offset(i% - 2, 0).Value = "Licencia"
ActiveCell.Offset(i% - 2, 0).Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveCell.Offset(-i% + 2, 0).Select
End If
i% = i% + 1
Loop

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, password:="123"
End If

Saludos