Compilation de plusieurs de fichiers excel

Range("A49:AI61").Select  
Range("A4").Activate  
Range(Selection, Selection.End(xlDown)).  

Const chemin As String = "J:\Alpine\Grille maquette temps\essai\feuilles de saisie\" 
Sub Compilation() 
Dim Fichier As String, Plage As String, Lig As Integer 
Dim source As Object, Requete As Object 

'initialisations générales 
Application.ScreenUpdating = False 
Fichier = Dir(chemin & "*.xls") 
Plage = "feuil2$A49:AI61" 
Lig = 4 

Do While Fichier <> "" 

     'se connecte au fichier en cours 
     Set source = CreateObject("ADODB.Connection") 
    source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
    "Data Source=Fichier ;Extended Properties=""Excel 8.0;HDR=No;"";" 
     
      'exerce la requete ADO sur la plage à recopier 
    Texte_SQL = "SELECT * FROM [" & Plage & "]" 
    Set Requete = CreateObject("ADODB.Recordset") 
    Set Requete = source.Execute(Texte_SQL) 
. 
     'restitution et préparation suivant 
     With Sheets("Bdd_hres") 
          .Cells(Lig, "A").CopyFromRecordset Requete 
          .Lig = Columns("A").Find("*", , , , , xlPrevious).Row + 1 
     End With 
      
     Set Requete = Nothing 
     Set source = Nothing 
     Fichier = Dir 
      
Loop 

End Sub 

Option Explicit    

Sub ImporterDonnees()    
Dim objShell As Object, objFolder As Object    
Dim Chemin As String, fichier As String    

    Set objShell = CreateObject("Shell.Application")    
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)    

If objFolder Is Nothing Then    
    MsgBox "Abandon opérateur", vbCritical, "Annulation"    
Else    
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"    
    fichier = Dir(Chemin & "*.xls")    
    Do While Len(fichier) > 0    
        If fichier <> ThisWorkbook.Name Then    
            ThisWorkbook.Names.Add "Plage", _    
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil2'!$A$49:$AI$61"    
            With Sheets("Temp")    
                .[A49:AI61] = "=Plage"    
                .[A49:AI61].Copy    
                Sheets("Bdd_hres").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues    
              End With    
        End If    
        fichier = Dir()    
    Loop    
End If    
End Sub