Evitar borrar Validación de datos en Excel al pegar datos copiados

Empiezo con una aclaración: por primera vez he eliminado una entrada luego de haberla publicado. Se trata de la entrada donde mostraba un código para evitar el problema de la destrucción de la validación de datos al pegar un valor copiado de otra celda. Había demasiadas circunstancias que provocaban que el código no funcionara. Mea culpa!

Volviendo sobre el tema, una de las debilidades de Validación de Datos es que si un usuario pega un valor en una celda del rango validado en lugar de ingresarlo manualmente, las definiciones de la validación quedan eliminadas.

La única forma de evitar estas situaciones es usar macros, más precisamente eventos.



Buscando en la Internet encontré, entre otras, una solución propuesta por John Walkenbach. El problema con esta solución es que si el usuario en lugar de pegar el valor usa la opción Pegado Especial-Valores (o Fórmulas), el evento no responde y el valor es aceptado.

El código que propongo usa una parte del código de Walkenbach, para el caso que el usuario use la opción de pegado común, y parte de mi código para el caso que use pegar-valores, pegar-fórmulas, Insertar o arrastre el valor a la celda.

En el módulo de Vba de la hoja pegamos estos códigos

Private Sub Worksheet_Change(ByVal Target As Range)
'   rutina desarrollada por Jorge Dunkelman - JLD Excel Blog
'   parte del codigo tomado de la nota de John Walkenbach http://www.j-walk.com/ss/excel/tips/tip98.htm

    Dim rngValid As Range, cell As Range
    Dim Msg As String
    Dim codeValid As Variant

    Set rngValid = Range("rngValidado")

    On Error Resume Next

    If Not HasValidation(rngValid) Then

         Application.Undo
         MsgBox "Valor no válido", vbCritical
         Application.EnableEvents = False
         Target.ClearContents
         Application.EnableEvents = True
     End If

    For Each cell In Target
        If Union(cell, rngValid).Address = rngValid.Address Then
            codeValid = ActiveCell.Validation.Value
            If codeValid = True Then
                Exit Sub
            Else
                MsgBox "Valor no válido", vbCritical
                Application.EnableEvents = False
                cell.ClearContents
                cell.Activate
                Application.EnableEvents = True
            End If
        End If
    
    Next cell

    

End Sub

Private Function HasValidation(r) As Boolean
    Dim x

    On Error Resume Next
    x = r.Validation.Type
    If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function


Nótese que estamos usando un evento Worksheet_Change y una función UDF.

Al rango B3:B12 de la hoja hemos aplicado validación de datos con la opción Lista. Los valores permitidos son a1, a2, a3 y a4.

Este video muestra cómo funciona la macro




El archivo con el ejemplo y el código puede descargarse aquí.