Bloquear solo una fila de celdas con macro

Hago un programa de control de hornos de curado. Tengo el un macro timer por fila de la hoja de trabajo y un módulo por cada timer. Necesito que al correr el macro del timer se bloqueen las celdas de esa columna pero permita modificar las demas.

Ya hice la prueba con Activesheet.protect e unprotect pero me bloquea toda la hoja. Cells.Locked = true.

Este el codigo de cada timer

Dim ejecutando6 As Boolean
Dim NO As String
Public Iniciar6 As Date
Sub setcrono6()
ejecutando4 = True
If Sheet1.Range("E8").Value = 0 Then
MsgBox "No ha ingresado datos", vbExclamation
Exit Sub
End If
horainicio1 = Now
For i = 1 To 9
  Cells(8, i).Interior.ColorIndex = 37
  Cells(8, i).Font.ColorIndex = 25
  'Cells(8, i).Locked = True
Next
Sheet1.Range("F8").Value = horainicio1
Set Cuenta6 = [L8]
[H8] = [L8]
'Call protege6
Call ProgramaCuentaRegresiva6
End Sub
Sub ProgramaCuentaRegresiva6()
    Iniciar6 = Now + TimeValue("00:00:01")
    Application.OnTime Earliesttime:=Iniciar6, procedure:="ProgramaCuenta6", Schedule:=True
End Sub
Sub ProgramaCuenta6()
Dim NO1 As String
Dim s As Integer
Dim hora As String
Dim Cuenta6 As Range
    Set Cuenta6 = [H8]
    Cells(8, 9).Interior.ColorIndex = 2
    Cuenta6.Value = Cuenta6.Value - TimeSerial(0, 0, 1)
    If Cuenta6 <= 0 Then
       hora = Format(Now, "HH:mm:ss")
             If hora > "15:30:00" Then
              Call EnviarEmail6
             End If
            NO1 = Sheet1.Range("B8").Text
            Sheet1.Range("K8") = ""
            Cells(8, "K") = ""
            Call avisa6
            'Cells(3, 8).Interior.ColorIndex = 3
            'NO1 = Sheet1.Range("B6").Text
            'MsgBox "Terminó el Tiempo de Proceso Traveler " + NO1, vbExclamation
            Call apagarcrono6
        Exit Sub
    End If
Call ProgramaCuentaRegresiva6
End Sub
Sub apagarcrono6()
ejecutando = False
On Error Resume Next
Application.OnTime Earliesttime:=Iniciar6, procedure:="ProgramaCuenta6", Schedule:=False
End Sub
Sub limpia6()
Sheet1.Range("B8:F8").ClearContents
For i = 1 To 9
  Cells(8, i).Interior.ColorIndex = 10
  Cells(8, i).Font.ColorIndex = 19
  Sheet1.Range("B8").Select
  'Resize(1, 5)
Next
End Sub
Sub avisa6()
NO1 = Sheet1.Range("B8").Text
Sheet1.Range("K8").Select
 If Cells(8, 11) <> "" Then
    MsgBox "Terminó el Tiempo de Proceso del Traveler " + NO1, vbExclamation
    Call limpia6
    Exit Sub
 End If
   Call SonidoControlado
    For q = 0 To 1000
       Cells(8, 9).Interior.ColorIndex = 3
    Next
    q = 0
    For q = 0 To 1000
      Cells(8, 9).Interior.ColorIndex = 2
    Next
     Application.OnTime Earliesttime:=Now + TimeValue("00:00:01"), procedure:="avisa6", Schedule:=True
End Sub
Sub protege6()
Dim p As Integer
For p = 1 To 9
Cells(8, p).Select
ActiveSheet.Unprotect Password
If IsEmpty(ActiveCell) Then
ActiveCell.Locked = False
Else
ActiveCell.Locked = True
End If
Next
End Sub

Añade tu respuesta

Haz clic para o