Sub Test_a10()
Dim sFichier, a As Workbook, wb As Workbook, Nom$
Set a = ThisWorkbook
sFichier = Application.GetOpenFilename(Title:="Choisir votre fichier Excel", FileFilter:="Fichier Excel *.xls* (*.xls*),")
If sFichier = False Then
MsgBox "Aucun fichier choisi!.", vbExclamation, "Erreur"
Exit Sub
Else
Application.ScreenUpdating = False
Set wb = Workbooks.Open(sFichier)
End If
Nom = Mid(wb.Name, InStrRev(wb.Name, ".") - 2, 2)
wb.Sheets(1).UsedRange.Copy
With a.Sheets.Add(after:=a.Sheets(a.Sheets.Count))
.Name = Nom: .Activate: .Paste
End With
Application.CutCopyMode = False
wb.Close False
End Sub