Option Explicit
Sub VLookUpACCOR()
Dim CelCible As Range, FichierACCOR As Variant, NomFicACCOR As String, RngSource As Range
Set CelCible = ActiveCell
FichierACCOR = Application.GetOpenFilename("Fichiers Excel (*.xl*), *.xl*", _
Title:="Fichier ACCOR pour RECHERCHEV")
If VarType(FichierACCOR) = vbString Then
On Error Resume Next
NomFicACCOR = Mid$(FichierACCOR, InStrRev(FichierACCOR, "\") + 1)
Workbooks(NomFicACCOR).Activate
If Err Then
Err.Clear: Workbooks.Open Filename:=FichierACCOR
ElseIf ActiveWorkbook.FullName <> FichierACCOR Then
Workbooks(NomFicACCOR).Close SaveChanges:=False
Err.Clear: Workbooks.Open Filename:=FichierACCOR
End If
If Err Then MsgBox Err.Description, vbCritical, "VLookUpACCOR": Exit Sub
On Error GoTo 0
Set RngSource = Cells(1, 1).Resize(Cells(1000000, 1).End(xlUp).Row, 2)
CelCible.FormulaR1C1 = "=VLOOKUP(RC[-4]," & RngSource.Address(RowAbsolute:=True, ColumnAbsolute:=True, _
ReferenceStyle:=xlR1C1, External:=True) & ",2,FALSE)"
Application.Goto CelCible
Else
MsgBox "Pas de fichier ACCOR sélectionné", vbCritical, "VLookUpACCOR"
End If
End Sub