Macro modification fichiers en Masse : erreur Type 13

Sub Protection()
MotPasse = "AAAA"
For Each Feuil In Worksheets  ' https://msdn.microsoft.com/fr-fr/library/office/ff840611.aspx
Feuil.Protect Password:=MotPasse, DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True
Next
End Sub


Sub Déprotection()
MotPasse = "AAAA"
For Each Feuil In Worksheets
Feuil.Unprotect MotPasse
Next
End Sub


Sub MRaccourci()
Set scrHst = CreateObject("WScript.Shell")
emplacement = "x:\Raccourcis FP & FD"
Set Raccourci = scrHst.CreateShortcut(emplacement & "\" & ThisWorkbook.Name & ".lnk")
Raccourci.WorkingDirectory = emplacement
Raccourci.TargetPath = ActiveWorkbook.FullName
Raccourci.Save
Set Raccourci = Nothing
Set scrHst = Nothing
  Range("C3").Select
End Sub

' Appel de la fonction
Option Explicit
Public nb As Integer
Sub Appel()
Dim chemin As String
    nb = 0
    chemin = "x:\Informatique"
    Modifier chemin
End Sub


Public Function Modifier(chemin As String)
Dim fs, Rep As Variant, NewRep As String, Nomfich As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Lister = fs.GetFolder(chemin).Files.Count
    Nomfich = Dir(chemin & "\*.xls")
    Do While Nomfich <> ""
        nb = nb + 1
        Workbooks.Open chemin & "\" & Nomfich 'Ouvre fichier'
        Déprotection 'déprotège
        MRaccourci 'crée le raccourcis
        Worksheets("FP JUIN").Range("T49").Value = "" 'Supprime contenu cellule
        Worksheets("MARS").Rows("16").EntireRow.Hidden = False 'Affiche ligne 16 mars
        Worksheets("MARS").Range("C16:AY16").Locked = True 'Verouille ligne 16 mars de C à AY
        Protection
        Nomfich = Dir()
    Loop
    'Pour chaque sous-répertoire, appel récursif de Lister
    For Each Rep In fs.GetFolder(chemin).SubFolders
        NewRep = Lister(Rep.Path)
    Next Rep
End Function