Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim wbSource As Workbook, wbDest As Workbook, fichier As String
Dim derlig As Long, cel As Range, tbl As Range, nom As String
Application.ScreenUpdating = False
Set wbDest = ThisWorkbook
Set cel = wbDest.Sheets("Base").Range("a2")
fichier = ThisWorkbook.Path & "\Fichiers source\" & cel.Value & ".xls"
Set wbSource = Workbooks.Open(fichier)
With wbSource.Sheets("Data")
derlig = .Range("a" & Rows.Count).End(xlUp).Row
Set tbl = .Range("a1:i" & derlig)
End With
Set Sh = wbDest.ActiveSheet
'Ici la feuille doit correspondre aux 2 derniers chiffres du classeur source
nom = Right(cel.Value, 2)
If Sh.Name = nom Then
tbl.Copy Sh.Range("a1")
Sh.Range("a:i").Columns.AutoFit
Application.DisplayAlerts = False
ActiveWorkbook.Close True
ThisWorkbook.Save
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close True
End If
End Sub
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