Macro para proteger rango de celdas con clave

Espero que me puedan ayudar con esta macro que construí con la grabadora de macros y tomando algunos ejemplos de internet.

La idea es que bloquee con clave un rango de celdas dado por la fila de la celda activa, y la clave que sea el valor de la celda activa, esta celda siempre debe estar en la columna A.

Me aparece "Error definido por la aplicación o el objeto"

Y se marca la fila "ActiveSheet.Protection.AllowEditRanges.Add"

Adicionalmente lo que no se me ocurre como hacer es que la macro pise los rangos ya creados, por ejemplo si para el rango de la fila 2 ya existe un bloqueo, que al pinchar se pise nuevamente ese rango.

Ojala se entienda y que me puedan ayudar.

Mi macro es la siguiente:

Sub Crearbloqueo()

Dim Nomrango, pass As String
Dim numfila As Long
Dim R As Range

Nomrango = "Rango" & (ActiveCell.Row)
numfila = ActiveCell.Row
pass = ActiveCell.Value

If pass = "" Or ActiveCell.Column <> 1 Then

MsgBox ("Debe seleccionar una celda válida, seleccione la celda donde está el nombre del tutor en la fila que desea asignar")

Exit Sub

Else

End If

Set R = Range(Cells(numfila, 1), Cells(numfila, 28))

ActiveSheet.Protection.AllowEditRanges.Add Title:=Nomrango, Range:=R, Password:=pass
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True

MsgBox ("La fila" & numfila & "para el tutor " & pass & " ya fue asegurada, puede derivar el caso")

End Sub

Añade tu respuesta

Haz clic para o