XL 2019 cellules qui se verrouillent après une copie

Sub Creation_Fichier_UR()
'
'Pour eviter le message : qu'une fnom de colonne que je veux copier contient le nom "xxx" qui existe sur la feuille de destination.
'Voulez-vous utiliser cette version du nom ?" ma réponse est toujours oui.

Application.DisplayAlerts = False
Application.EnableEvents = False


'Deproteger
 Call Initialisation_Variables_Public
 Call Deverrouiller_feuille(Onglet_Synthèse)    'du fichier POurscission
 
  '  MsgBox ("onglet synt : " & Onglet_Synthèse)
  'decalage = ListObjects("T_UR2").HeaderRowRange.Row
  decal = Range("T_UR2[[#Headers]]").Row
  Ent = "A" & (decal + 1)
  'MsgBox ("1ere ligne apres entete : " & decal)
  sheet_1 = ActiveSheet.Name
 ' Fichier UR
 '----------
 'UR_Repertoire = "Z:\S3A - Documents de service\Procédures\MEQ Recherche\"
 'UR_Repertoire = [REP_BO_Extracion]
 AR_Repertoire = [Rep_BO_Extraction]
 Ar_fichier = [Fich_BO_Extraction]
 UR_Date = Format([Extract_Date], "dd/mm/yy")
 
 MsgBox ("AR fichier: " & Ar_fichier)
 Nb_Lig = [T_UR_Nom].Rows.Count
 'For I = 1 To Nb_Lig
  For I = 1 To 2
    Windows(Ar_fichier).Activate
     'Windows("Recherche_Extraction_BO_4_TestPQue.xlsm").Activate    ' necessaire car VBA est resté actif sur le dernier fichier modifie de chaque UR
    UR_Nomfichier = Worksheets("Parametres").Range("T_UR_Nom[Nom_fichier]").Rows(I)
    
    '----Exceldownloads
    UR_Nomfichier = [T_UR_Nom[Nom_fichier]].Rows(I)
    MsgBox ("fichier UR : " & UR_Nomfichier)
    Critere = [T_UR_Nom[sigles UR]].Rows(I)
    
    With Workbooks.Open(Filename:=[Rep_UR] & UR_Nomfichier & ".xlsm")  ' ouverture du fichier dans lequel on va copier une partie du fichier d'origine
        [T_Ur].Parent.Activate ' Activation de la feuille du tableau
        Set Onglet_UR = ActiveWorkbook.Worksheets("TableauSynthese_UR")
        Call Deverrouiller_feuille(Onglet_UR)
        'Deverrouiller_feuille ActiveSheet
            'vider le tableau
             If Not Range("T_UR").ListObject.DataBodyRange Is Nothing Then
              Range("T_UR").ListObject.DataBodyRange.Delete
            End If
            Onglet_Synthèse.[T_Ur2].AutoFilter Field:=1, Criteria1:=Critere
            Onglet_Synthèse.[T_Ur2[#Data]].SpecialCells(xlCellTypeVisible).Copy
            ActiveSheet.Paste [T_Ur[#Data]]
            [UR_Extract_Date] = UR_Date
        'Verouiller_feuille ActiveSheet
        'Call Verouiller_feuille(Onglet_UR)
         Onglet_UR.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
        True, AllowSorting:=True, AllowFiltering:=True
        .Close saveChanges:=True
    End With
    '----Exceldownloads
    
    '
      
            
    
    'Fin fichier UR
    '--------------
Next
    [T_Ur2].ListObject.AutoFilter.ShowAllData
    Call Verouiller_feuille(Onglet_Synthèse)    ' unquement à la fin de la creation de tous les fichiers ?
    
    
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

ActiveSheet.Paste [T_Ur[#Data]]

[T_Ur[#Data]].PasteSpecial paste:=xlPasteValues