La macro qui s'effectue une fois correctement, après plus rien!!

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

Dim nValue As String
Dim NewVal As String
Dim f As Worksheet
Dim sheetName As String


Application.ScreenUpdating = False

For Each f In ActiveWorkbook.Worksheets
    f.Unprotect
Next

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$(Application.InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO", Type:=2))
            ActiveCell = NewVal
            
            
            
      
            If InStr(1, nValue, "C") = 1 Or InStr(1, nValue, "M") = 1 Then
                sheetName = "CPTU"
            ElseIf InStr(1, nValue, "F") = 1 Then
                sheetName = "FORAGE"
            ElseIf InStr(1, nValue, "Z") = 1 Or InStr(1, nValue, "FZ") = 1 Then
                sheetName = "Piézomètres"
               
            ElseIf InStr(1, nValue, "I") = 1 Then
                sheetName = "Inclinomètres"
                
            Else
                sheetName = ""
                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 Len(sheetName) > 0 Then
                Sheets(sheetName).Columns(1).Replace nValue, NewVal, LookAt:=xlWhole, SearchOrder:=xlByColumns
                End If
            
                
                                   
     
        If var <> Target Then
        var = Target.Value
        MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
    
        End If
        
    Else
    
    ActiveCell.Select
    
    End If
    
End If

For Each f In ActiveWorkbook.Worksheets
            f.Protect
        Next

Application.ScreenUpdating = True

ActiveCell.Offset(-1, 0).Select 'Range("B5").Select
 
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Unprotect

If Target.Column >= 3 And Target.Column <= 5 Then
        'desactive les evenements excel: eviter appel recurcif a la suite du passage en majuscule
        Application.EnableEvents = False
        Target = UCase(Target)
    End If
    'active les evenements excel
    Application.EnableEvents = True


If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 5 Or Target.Column <> 5 Then Exit Sub
If Target.Value = "" Then Cells(Target.Row, 1).ClearContents
If Range("A5") <> "" Then
    dlig = Range("E5").End(xlDown).Row
    Set PL = Range("A5:A" & dlig)
    PL.Value = Range("a5").Value
   
End If


Dim T As Range, i&
Set T = [TableauCoord]
Application.EnableEvents = False
On Error Resume Next 'sécurité
If T.Rows.Count < 4 Then
  Application.Undo 'annulation
Else
  '---suppression des lignes vides---
  For i = T.Rows.Count - 1 To 4 Step -1
    If T(i, 1) = "" Then T(i, 1).EntireRow.Delete
  Next
  '---ajout de ligne---
  If T(T.Rows.Count, 1) <> "" Then
    Application.ScreenUpdating = False
    T(T.Rows.Count, 1).EntireRow.Insert
    T.Rows(T.Rows.Count - 1).FormulaR1C1 = T.Rows(T.Rows.Count).FormulaR1C1
    T.Rows(T.Rows.Count) = ""
    Application.ScreenUpdating = True
  End If
End If

Application.EnableEvents = True

ActiveSheet.Protect

End Sub

Private Sub worksheet_activate()
   
Dim resultat As String
Const Dossier As String = "6.02.06.MT.02."

ActiveSheet.Unprotect
If Range("a5") = 0 Then
    resultat = UCase(InputBox("Entrez le numéro du Bassin Versant!", "Bassin Versant"))
    If resultat <> "" Then
        dlig = Range("E5").End(xlDown).Row
        Set PL = Range("A5:A" & dlig)
        PL.Value = Dossier & resultat
    End If
    
End If

ActiveSheet.Protect
Range("b5").Select


End Sub