Récupération de données multi fichiers

Option Explicit
Sub AjoutTableau()
  Dim VFic As String, VPath As String
  Dim Dlig As Long  ' Dernière ligne de la liste de fichier
  Dim NextLig As Long ' Dernière ligne pour coller le tableau
  Dim ShtD As Worksheet ' Feuille de destination dans ce classeur
  Dim Lig As Long ' Ligne de la liste de fichiers
  Dim ShtS As Worksheet ' Feuille source du classeur ouvert
  Dim DLigF As Long ' Dernière ligne du fichier ouvert
  ' Définir le répertoire ou se trouvent les fichiers
  VPath = "D:\MonRépertoire\"
  If Right(VPath, 1) <> "\" Then VPath = VPath & "\"
  ' Récupérer la dernière ligne de la liste des fichiers se trouvant dans la colonne A
  Dlig = ThisWorkbook.Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
  ' Définir la feuille de destination pour les tableau
  Set ShtD = ThisWorkbook.Sheets("Feuil2")
  ' Définir la prochaine ligne pour coller le tableau
  NextLig = ShtD.Range("A" & Rows.Count).End(xlUp).Row + 1
  ' Pour chaque ligne
  For Lig = 1 To Dlig
    ' Récupérer le nom du fichier
    VFic = Sheets("Feuil1").Range("A" & Lig).Value
    If Right(VFic, 4) <> ".xls" Then VFic = VFic & ".xls"
    ' Ouvrir le fichier en question
    Workbooks.Open VPath & VFic
    ' Définir la feuille source
    Set ShtS = ActiveWorkbook.Sheets("D2")
    ' Récupérer la dernière ligne du tableau, colonne en fonction
    DLigF = ShtS.Range("A" & Rows.Count).End(xlUp).Row
    ' Copier et coller le tableau
    ShtS.Range("A1:F" & DLigF).Copy Destination:=ShtD.Range("A" & NextLig)
    ' Recalculer la prochaine ligne pour le tableau
    NextLig = ShtD.Range("A" & Rows.Count).End(xlUp).Row + 1
    ' Efface la variable objet pour la feuille source
    Set ShtS = Nothing
  Next Lig
  ' Efface les variables objet
  Set ShtS = Nothing
  Set ShtD = Nothing
End Sub