Macro per inserire / eliminare righe in tabella protetta

Option Explicit
Public Rg As Long
Public Ur As Long
Private Sub Worksheet_Change(ByVal Target As Range)
If Ur = 0 Then Ur = Range("A" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("F8:F" & Ur)) Is Nothing Then
        If Target.Offset(0, -4).Value = "F" And Left(Target.Offset(0, 0).Value, 3) = "R20" Then
            Application.EnableEvents = False
            Rg = Target.Row
            ActiveSheet.Unprotect Password:="12345" 'cambiare password?
            ActiveSheet.Range("J" & Rg & ":K" & Rg) = ""
            Application.EnableEvents = True
            MsgBox "Inserire prima i dati in cella J" & Rg & ", subito dopo in K" & Rg
        End If
    ElseIf Not Intersect(Target, Range("K8:K" & Ur)) Is Nothing Then
        If Target.Offset(0, -1).Value <> "" And Target.Offset(0, 0).Value <> "" Then
            ActiveSheet.Protect Password:="12345", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
        End If
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Val1 As Double, Val2 As Double
If Ur = 0 Then Ur = Range("A" & Rows.Count).End(xlUp).Row
    If Not Intersect(Target, Range("F8:F" & Ur)) Is Nothing Then
        If Target.Offset(0, -4).Value = "F" And Left(Target.Offset(0, 0).Value, 3) = "R20" Then
            Application.EnableEvents = False
            Rg = Target.Row
            Val1 = InputBox("Inserire il valore di J" & Rg, 0)
            Val2 = InputBox("Inserire il valore di K" & Rg, 0)
            ActiveSheet.Unprotect Password:="12345" 'cambiare password?
            ActiveSheet.Range("J" & Rg) = Val1
            ActiveSheet.Range("K" & Rg) = Val2
            Application.EnableEvents = True
            ActiveSheet.Protect Password:="12345", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
        End If
    End If
End Sub

Sub Aggiungi_Riga()
Application.EnableEvents = False
Dim Ur As Long, Rg As Long, val As Long, Risp As Integer
Ur = Range("A" & Rows.Count).End(xlUp).Row
Cells(Ur, 1).Activate
    Risp = MsgBox(prompt:="Desideri aggiungere una riga?", Buttons:=vbYesNo)
    If Risp = vbYes Then
        ActiveSheet.Unprotect Password:="12345" 'cambiare password?
        Rows(Ur & ":" & Ur).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveWorkbook.Worksheets("Clienti_2018").ListObjects("Clienti1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Clienti_2018").ListObjects("Clienti1").Sort. _
        SortFields.Add Key:=Range("Clienti1[Dt_FT/Pag]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Clienti_2018").ListObjects("Clienti1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With
        'cambiare password?
        ActiveSheet.Protect Password:="12345", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    End If
Application.EnableEvents = True
End Sub

Sub Elimina_Riga()
Dim Rr As Long, Risposta As Integer
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="12345" 'cambiare password?
Rr = Selection.Row
Risposta = MsgBox(prompt:="Desideri eliminare le celle A" & Rr & ":R" & Rr & " ?", Buttons:=vbYesNo)
    If Risposta = vbYes Then
        If Selection.Count = 18 Then
            Range("A" & Rr & ":R" & Rr).Delete
        Else
            MsgBox "Devi selezionare tutte le celle da A" & Rr & ":R" & Rr & " per eliminare."
        End If
    End If
ActiveSheet.Protect Password:="12345", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True 'cambiare password?
Application.EnableEvents = True
End Sub