Remplacer d'un fichier dans une recherchV

bonjour

je ne sais pas trop comment présenter mon problème, et vu le volume des fichier je ne peux pas les joindre à ma question.

mon problème est le suivant :

Afin d'éviter à mes collègues qui ne connaissent pas le vba je souhaite remplacer le nom d"un fichier dans ma recherchv . ci dessous ma recherchv ( qui fonctionne)

With Cells(ligne, 22)
  .Formula = "=IFERROR(VLOOKUP(RC[-20],'[STO002F---INVENTAIRE des  PALETTES 10-10-2021-rapprochement.xls]Sheet1'!R10C2:R18114C11,1,FALSE),"""")"
     .Value = .Value
 End With

et ci dessous ce que je souhaiterai écrire mais qui bug.

With Cells(ligne, 22)
 .Formula = "=IFERROR(VLOOKUP(RC[-20],'" & [ Fichier ] & "sheet1'!R10C2:R18114C11,1,FALSE),"""")"
 .Value = .Value
End With

ci dessous les divers informations sur les fichiers

Ci dessous la partie du vba concerné que j'ai epurré.

Sub Rapprochement()

Dim Chemin As String
Dim Fichier As String
dim Fichier1 As String

    Chemin = "S:\Supply_Chain\"
    Fichier = Range("j2").Text & ".xls"
    Fichier1 = Range("n2").Text & ".xlsm"

    SendKeys "{ENTER}", True
    MsgBox Chemin
    SendKeys "{ENTER}", True
    MsgBox Fichier

    Workbooks.Open Chemin & Fichier

  Windows(Fichier1).Activate 

 'on supprime les données
   Range("v6:x100000").Select
      Selection.ClearContents

 Dim ligne As Long

 ligne = 6

Do While Cells(ligne, 2).Value <> ""

'rapprochement
With Cells(ligne, 22)
 .Formula = "=IFERROR(VLOOKUP(RC[-20],'" & [ Fichier ] & "sheet1'!R10C2:R18114C11,1,FALSE),"""")"
 .Value = .Value
End With

ligne=ligne+1
loop
end sub

Bonjour,

Pour commencer lorsque je vois

SendKeys "{ENTER}", True

Ca commence très mal

Ensuite, sans fichier... j'aurais envie de dire "débrouillez-vous"

@+

ci joint les fichiers que j'ai épuré en nombre de ligne et le vba

merci de votre aide

Bonjour Philippe87

Voici le code modifié et optimisé

Sub Rapprochement()
  Dim dLigD As Long, dLigS As Long
  Dim Chemin As String
  Dim sFicS As String ' Fichier source à importer
  Dim Wbk As Workbook ' Ce classeur
  Dim ShtD As Worksheet ' la feuille de ce classeur
  Dim sForm As String ' Pour la formuel à écrire

  ' On dit à excel de travailer en arriére plan
  Application.ScreenUpdating = False
  ' Initialisation
  Chemin = "S:\Supply_Chain\"
  'Chemin = ThisWorkbook.Path & "\"    ' Pour le test
  sFicS = ThisWorkbook.Sheets(1).Range("J2").Text & ".xls"
  ' Ouvrir le classeur à importer
  Set Wbk = Workbooks.Open(Chemin & sFicS)
  ' Nombre de lignes remplies dans le fichier
  dLigS = Wbk.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
  ' Activer ce classeur
  ThisWorkbook.Activate
  ' Définir la feuille de destination
  Set ShtD = ThisWorkbook.Sheets("Feuil1")
  ' Dernière ligne remplie de la feuille
  dLigD = ShtD.Range("A" & Rows.Count).End(xlUp).Row
  ' Effacer l'import existant
  If dLigD > 5 Then ShtD.Range("V6:X" & dLigD).ClearContents
  ' Définir la formule
  sForm = "=SIERREUR(RECHERCHEV(B6;'[" & sFicS & "]Sheet1'!$B$2:$K$" & dLigS & ";1;FAUX);"""")"
  ' Rapprochement, Inscrire la formule sur toutes les lignes
  With ShtD.Range("V6:V" & dLigD)
    .FormulaLocal = sForm
    .Value = .Value
  End With
  'on remet excel en avant plan
  Application.ScreenUpdating = True
  MsgBox "traitement terminé"
End Sub

@+