XL 2013 Code pour ne pas enregistrer et lecture seule automatique[RESOLU]

Private Function ChoisirDossier() As String
 Dim objShell
 Dim objFolder
 Set objShell = CreateObject("Shell.Application")
 Set objFolder = objShell.BrowseForFolder _
     (&H0&, "Sélectionnez un Dossier", &H1&)
 On Error GoTo Erreur
 ChoisirDossier = objFolder.ParentFolder _
     .ParseName(objFolder.Title).Path & ""
 Exit Function
Erreur:
 ChoisirDossier = ""
 End Function

 Sub NOM()

 Dim FSO 'As Scripting.FileSystemObject
 Dim SourceFolder 'As Scripting.Folder
 Dim FileItem 'As Scripting.File
 Dim chemin$
 Dim T()
 Dim cpt&
 Dim g&
 Dim i&
 Dim j&
 Dim Lig&
 Dim var
 Dim WB As Workbook
 Dim S As Worksheet
 Dim DEST As Worksheet
 Dim Info(1 To 1, 1 To 26)
 '------------
 chemin$ = "C:\Downloads"
 If chemin$ = "" Then Exit Sub
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set SourceFolder = FSO.GetFolder(chemin$)
 If SourceFolder.Files.Count = 0 Then Exit Sub
 For Each FileItem In SourceFolder.Files
   If LCase(Right(FileItem.Name, 4)) = ".xls" Or LCase(Right(FileItem.Name, 5)) = ".xlsx" Or LCase(Right(FileItem.Name, 5)) = ".xlsm" Then
     cpt& = cpt& + 1
     ReDim Preserve T(1 To cpt&)
     T(cpt&) = chemin$ & "\" & FileItem.Name
   End If
 Next FileItem
 Set FileItem = Nothing
 Set SourceFolder = Nothing
 Set FSO = Nothing
 '------------
 Application.ScreenUpdating = False
 Set DEST = Sheets.Add
 Lig& = 1
 For g& = 1 To UBound(T)
   Set WB = GetObject(T(g&))
   Set S = WB.Sheets("NOM")
   Info(1, 1) = S.Range("c1")
   Info(1, 2) = S.Range("d35")
   Info(1, 3) = S.Range("d36")
   Info(1, 4) = S.Range("e35")
   Info(1, 5) = S.Range("e36")
   WB.Close
   Set WB = Nothing
   Lig& = Lig& + 1
   DEST.Range(DEST.Cells(Lig&, 1), _
         DEST.Cells(Lig&, UBound(Info, 2))) = Info
   Erase Info
 Next g&
 var = Array("NOM")
 With DEST
   .Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
   .Range("a1:e1").Interior.ColorIndex = 6
 End With
 Application.ScreenUpdating = False
 Exit Sub
Erreur:
 Application.ScreenUpdating = False
 MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
 End Sub