Importer données avec fenêtre windows

Sub TestCopiFeuil()
Dim Fichs As Variant
ChDir ThisWorkbook.Path
Fichs = Application.GetOpenFilename("fichier excel (*.xls), *.xls", , "Sélect Fichier(s)", , True)
If TypeName(Fichs) = "Boolean" Then Exit Sub

On Error GoTo TraitErreur: Err.Clear
Application.ScreenUpdating = False
Application.EnableEvents = False
For I = LBound(Fichs) To UBound(Fichs)
  Workbooks.Open Fichs(I): Sheets(1).Select: NomClasOpen$ = ActiveWorkbook.Name
  ActiveSheet.Copy After:=Workbooks(ThisWorkbook.Name).Sheets(ThisWorkbook.Sheets.Count)
  Application.DisplayAlerts = False
  Workbooks(NomClasOpen$).Close SaveChanges:=False
  Application.DisplayAlerts = True
  ThisWorkbook.Activate
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
M$ = "Nombre de Fichier(s)= " & UBound(Fichs): MsgBox M$, vbOKOnly, "Opération terminée"
Exit Sub

TraitErreur: 's/prog
Application.ScreenUpdating = True
Application.EnableEvents = True
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
MsgBox Msg$, vbCritical, "", Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear: Exit Sub
End Sub