Registro de celdas utilizando VBA
Lo que quiero que el código realice es que en un rango de celdas al momento de escribir se bloquee y pase a la próxima celda, lo hace pero se coloca en la ultima celda del rango y eso no me funciona ya que son rangos muy grandes y debo recorrerme de nuevo a la siguiente celda. Mi codigo es el Siguiente:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4:B444")) Is Nothing Then
ActiveSheet.Unprotect Password:="1818"
Set Rng = Range("B4:B444")
ActiveSheet.Unprotect
For Each celda In Rng
celda.Select
If celda = "" Then
Selection.Locked = False
Selection.FormulaHidden = False
Else
Selection.Locked = True
Selection.FormulaHidden = False
End If
Next
ActiveSheet.Protect Password:="1818", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End If
End Sub
1 respuesta
H ol a: Te anexo la macro actualizada
Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
Set Rng = Range("B4:B444")
If Not Intersect(Target, Rng) Is Nothing Then
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="1818"
For Each celda In Rng
'celda.Select
If celda = "" Then
celda.Locked = False
Else
celda.Locked = True
End If
celda.FormulaHidden = False
Next
Target.Offset(1, 0).Select
ActiveSheet.Protect Password:="1818", _
DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End If
End SubPero si solamente quieres bloquear la celda que modificaste, también pude ser así:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range("B4:B444")) Is Nothing Then
ActiveSheet.Unprotect Password:="1818"
Target.Locked = True
Target.Offset(1, 0).Select
ActiveSheet.Protect Password:="1818", _
DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
