¿Cómo asignar valores a un rango?

Tengo el siguiente código, que me valida si la celda tiene "validación de datos", revisa si se encuentra en el listado permitido y sino no deja pegar datos con Ctrl+V solo con Pegar Valores.

Mi duda es:

Tengo que hacer el pegado en varias columnas, este solo me lo hace en la primera, intento establecer mediante un select case o un If pero no me lo permite. ¿Cómo puedo decirle que haga el recorrido en la siguiente columna con un nombre de rango diferente?
Dejo el archivo ejemplo y código:
https://drive.google.com/file/d/1aLmlPpEJDT_04CSmY9gbk2UYP3iP_m5p/view?usp=sharing 

Option Explicit
Dim PegarValor As Range, Celda As Range, Empleado As Variant
'Evento que se produce cuando cambia cualquier celda en la
Private Sub Worksheet_Change(ByVal Target As Range)
'Procedimiento que deja pegar solamente valores en
'el rango de Excel llamado "ModEquipo1"
    Set PegarValor = Range("ModEquipo1")
    On Error Resume Next
    If Not ValidaciónExitosa(PegarValor) Then
         Application.Undo
         MsgBox ("En esta celda solo se puede pegar valores")
         Application.EnableEvents = False
         Target.ClearContents
         Application.EnableEvents = True
     End If
     RecorrerCeldas
     End Sub
    ' Procedimiento que recorre todas las celdas del rango de Excel
 'llamado "ModEquipo1" verificando que tengan un valor valido
  Sub RecorrerCeldas()
  Set PegarValor = Range("ModEquipo1")
    MsgBox Celda.Value
    For Each Celda In PegarValor
        If Union(Celda, PegarValor).Address = PegarValor.Address Then
            Empleado = ActiveCell.Validation.Value
            If Empleado = True Then
                Exit Sub
            Else
                MsgBox ("Conductor Inexistnte")
                Application.EnableEvents = False
                Celda.ClearContents
                Celda.Activate
                Application.EnableEvents = True
            End If
        End If
    Next Celda
End Sub
'Función definida por el usuario que sirve como filtro inicial
'indicando  que Sí  la celda que cambio tiene Validación de Datos continúa
'en caso contrario hasta ahi llega el procedimiento.
Private Function ValidaciónExitosa(ParaEvaluar) As Boolean
    Dim ErrorEvaluado As Variant
    On Error Resume Next
    ErrorEvaluado = ParaEvaluar.Validation.Type
    If Err.Number = 0 Then
    ValidaciónExitosa = True
    Else: ValidaciónExitosa = False
    'Como los proedimientos se leen de arriba hacía abajo,
    'Cuando llega a este punto y no encuentra más código
    'Se acaba la ejecución.
    End If
End Function

Añade tu respuesta

Haz clic para o