Problème de protection lors de copie avec macro

Private dlig As Long
Private PL As Range
Option Explicit
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim nvalue As String
Dim NewVal As Variant
Dim f As Worksheet
Dim valueRange As Range
Dim Cpt As Integer
Dim nombre As Integer
Dim i As Integer

Application.ScreenUpdating = False


nvalue = ActiveCell.Value

If Not Intersect(Target, Range("c5:c" & [a1048576].End(xlUp).Row + 1)) Is Nothing Then
        
    If MsgBox("Voulez-vous mofifier le numéro de ce sondage?", _
        vbYesNo + vbQuestion, "MODIFER") = vbYes Then
        
        NewVal = UCase(InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO"))
        
        If NewVal = "" Then
            ActiveCell.Offset(-1, 0).Select
            Exit Sub
        Else
            ActiveCell = NewVal
        End If
        
            If InStr(1, nvalue, "C") = 1 Or InStr(1, nvalue, "M") = 1 Then
                Set valueRange = Sheets("CPTU").Columns(1)
                                
            ElseIf InStr(1, nvalue, "F") = 1 Then
                Set valueRange = Sheets("FORAGE").Columns(1)
                
            ElseIf InStr(1, nvalue, "Z") = 1 Or InStr(1, nvalue, "FZ") = 1 Then
                Set valueRange = Sheets("Piézomètres").Columns(2)
                
               
            ElseIf InStr(1, nvalue, "I") = 1 Then
                Set valueRange = Sheets("Inclinomètres").Columns(2)
                
            Else
                Set valueRange = Nothing
                MsgBox "La valeur n'a pas été trouvé dans les autres feuilles! Mettre à jours les feuillets sur la page d'accueil!", vbCritical
            End If
            
                If Not valueRange Is Nothing Then
                    nombre = ActiveWorkbook.Sheets.Count
                    Application.ScreenUpdating = False
                        For i = 1 To nombre
                        Worksheets(i).Unprotect
                        Next i
                    valueRange.Replace nvalue, NewVal, lookat:=xlWhole, searchorder:=xlByColumns
                End If
                                   
        If NewVal <> nvalue Then
        MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
        ActiveCell.Offset(-1, 0).Select
        End If
        
    nombre = ActiveWorkbook.Sheets.Count
    Application.ScreenUpdating = False
    For i = 1 To nombre
    Worksheets(i).Protect
    Next i
    
    Else
    
    ActiveCell.Offset(-1, 0).Select
    
    End If
    
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub