Macro que valida datos no funciona al copiar desde otro libro
publicado
Hola buenos días tengo un archivo el necesito que me valide los datos cuando copio desde
otro archivo pero no lo esta haciendo me explico en la hoja del archivo original tengo el siguiente código, que me valida que no se inserten letras en la columna A y H y que no se inserten números en las columnas B;C,D,E,F el código me funciona cuando dígito pero si pego desde otro archivo por ejemplo letras al campo cedula no me funciona, me podrías ayudar que me hace falta por favor o si quieres te mando el archivo al correo, muchas gracias por tu ayuda.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A, H:H")) Is Nothing Then
For Each cel In Target
For i = 1 To Len(cel)
If Not IsNumeric(Mid(cel, i, 1)) Then
MsgBox "En esta celda no se permiten letras", vbCritical
Application.EnableEvents = False
cel.Value = c
Application.EnableEvents = True
cel.Select
SendKeys "{F2}", True
Exit For
End If
c = c & Mid(cel, i, 1)
Next
Next
End If
If Not Intersect(Target, Range("B:F")) Is Nothing Then
c = ""
For Each cel In Target
For i = 1 To Len(cel)
If IsNumeric(Mid(cel, i, 1)) Then
MsgBox "En esta celda no se permiten números", vbCritical
Application.EnableEvents = False
cel.Value = c
Application.EnableEvents = True
Range(cel.Address).Select
SendKeys "{F2}", True
Exit For
End If
c = c & Mid(cel, i, 1)
Next
Next
End If
End Sub
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Hola buenos días tengo un archivo el necesito que me valide los datos cuando copio desde
otro archivo pero no lo esta haciendo me explico en la hoja del archivo original tengo el siguiente código, que me valida que no se inserten letras en la columna A y H y que no se inserten números en las columnas B;C,D,E,F el código me funciona cuando dígito pero si pego desde otro archivo por ejemplo letras al campo cedula no me funciona, me podrías ayudar que me hace falta por favor o si quieres te mando el archivo al correo, muchas gracias por tu ayuda.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A, H:H")) Is Nothing Then
For Each cel In Target
For i = 1 To Len(cel)
If Not IsNumeric(Mid(cel, i, 1)) Then
MsgBox "En esta celda no se permiten letras", vbCritical
Application.EnableEvents = False
cel.Value = c
Application.EnableEvents = True
cel.Select
SendKeys "{F2}", True
Exit For
End If
c = c & Mid(cel, i, 1)
Next
Next
End If
If Not Intersect(Target, Range("B:F")) Is Nothing Then
c = ""
For Each cel In Target
For i = 1 To Len(cel)
If IsNumeric(Mid(cel, i, 1)) Then
MsgBox "En esta celda no se permiten números", vbCritical
Application.EnableEvents = False
cel.Value = c
Application.EnableEvents = True
Range(cel.Address).Select
SendKeys "{F2}", True
Exit For
End If
c = c & Mid(cel, i, 1)
Next
Next
End If
End Sub