Compiler plusieurs fichiers excel

---- Exécuter la procédure Appel ----
Public msg As String, Cpt as Integer

Sub Appel()
Dim FL1 As Workbook, Chemin As String
    Application.ScreenUpdating = False
        Chemin = "D:\xls"
        Set FL1 = ThisWorkbook
        Ouvrir Chemin, FL1
    Application.ScreenUpdating = True
    MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub
---- Ouverture des fichiers ----
Sub Ouvrir(Chemin As String, FL1 As Workbook)
Dim NomFich As String
    NomFich = Dir(Chemin & "\")
    If NomFich = "" Or Right(NomFich, 4) <> ".xls" Then
         MsgBox "Aucun fichier trouvé dans " & Chemin & "."
         Exit Sub
    End If
    Do While NomFich <> ""
        Application.EnableEvents = False
            Workbooks.Open Chemin & "\" & NomFich
            DoEvents
        Application.EnableEvents = True
        NomFich = ActiveWorkbook.Name
        Copie NomFich, FL1
        NomFich = Dir
    Loop
End Sub
---- Copie des feuilles ----
Sub Copie(NomFich As String, FL1 As Workbook)
    Application.EnableEvents = False
        For Each LaFeuille In Workbooks(NomFich).Worksheets
            'MsgBox LaFeuille.Name
            On Error Resume Next
            LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
            DoEvents
            If ActiveSheet.Protect = True Then ActiveSheet.Unprotect
            ActiveSheet.UsedRange.Copy
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                Err.Clear
                On Error GoTo 0
            End If
            DoEvents
            If Cpt Mod 200 = 0 Then
                ThisWorkbook.Save
                DoEvents
            End If
        Next
    Application.EnableEvents = True
    'Fermeture du classeur
    Application.DisplayAlerts = False
        Workbooks(NomFich).Close False
    Application.DisplayAlerts = True
    DoEvents
End Sub