Ajout d'une variable a partir d'une cellule dans mon code

Bonjour

Je veux faire en sorte que la cellule F4 de ma feuille devienne une variable dans mon code VBA

Ce qui donnerait normalement genre fichier = " *ma_cellule.xlsx"

le code recherche tout les fichiers d'un dossier et copie les cellule demander dans une page voulu, et cela fonctionne très bien.

Ma cellule F4 comporte une liste déroulante contenant les numéro de mes clients

les fichiers son des factures et se nommes exemple: 140001-20001.xlsx

Mais moi j'ai besoin qu'il prenne " *F4.xlsx pour qu'il tri afin de récupérer les fichiers spécifique.

J'ai essayer de plusieurs manière et j'y arrive pas.

Merci à l'avance.

Voici le code ...

Option Explicit

Sub Creer_Recapitulatif()

Dim Obj, RepP, Fichier, F1

Dim i As Integer, Lig As Long

Dim Chemin As String

Dim WksDest As Worksheet

Dim wlSource As Worksheet

Dim TB

' Vider la page

Dim a

With ThisWorkbook.Sheets(1)

a = .Range("A1").SpecialCells(xlCellTypeLastCell).Address

With Range("A5:" & a)

.ClearContents

.Interior.Pattern = xlNone

.Borders(xlInsideVertical).LineStyle = xlNone

.Borders(xlInsideHorizontal).LineStyle = xlNone

.Borders(xlEdgeTop).LineStyle = xlNone

End With

End With

'Fin vidé la page

Application.ScreenUpdating = False

TB = Array(" ", "d4", "C5", "K2", "j4", "C6", "C7", "K32", "k33", "k35", "k36", "k37", "k38")

Chemin = "D:\smc\Factures\" 'Adapter le répertoire

Set WksDest = ThisWorkbook.Sheets(1) 'feuille de destination

Lig = WksDest.Cells(Rows.Count, 1).End(xlUp).Row + 1 '1ère ligne où commencer les transferts

Set Obj = CreateObject("Scripting.FileSystemObject")

Set RepP = Obj.GetFolder(Chemin)

Set Fichier = RepP.Files

For Each F1 In Fichier 'boucle sur tout les fichiers du répertoire

If F1 Like "*" Then ' recherche tout les fichiers a partir de l'étoile "*"

Workbooks.Open F1

'Le fichier qu'ont vient d'ouvrir est toujours le fichier actif.

With ActiveWorkbook.Sheets(1) 'Travail avec l'index feuille et pas le nom

For i = 1 To UBound(TB)

WksDest.Cells(Lig, i) = .Range(TB(i))

Next i

'Copie pour avoir aussi le format

'.Range("K9").Copy WksDest.Cells(Lig, i)

'Ferme le classeur sans sauver et sans message.

ActiveWorkbook.Close False

Lig = Lig + 1

End With

End If

Next F1

Set RepP = Nothing

Set Obj = Nothing

End Sub

Bonsoir

Sans fichiers pour tester, pas évident

Modifies ta macro et testes

Option Explicit
Sub Creer_Recapitulatif()
Dim Obj, RepP, Fichier, F1
Dim i As Integer, Lig As Long
Dim Chemin As String
Dim WksDest As Worksheet
Dim wlSource As Worksheet
Dim TB
Dim Nom As String

  ' Vider la page
Dim a
  With ThisWorkbook.Sheets(1)
    a = .Range("A1").SpecialCells(xlCellTypeLastCell).Address
    With Range("A5:" & a)
      .ClearContents
      .Interior.Pattern = xlNone
      .Borders(xlInsideVertical).LineStyle = xlNone
      .Borders(xlInsideHorizontal).LineStyle = xlNone
      .Borders(xlEdgeTop).LineStyle = xlNone
    End With
  End With
  'Fin vidé la page

  Application.ScreenUpdating = False
  Nom = Range("F4")
  TB = Array(" ", "d4", "C5", "K2", "j4", "C6", "C7", "K32", "k33", "k35", "k36", "k37", "k38")
  Chemin = "D:\smc\Factures\"  'Adapter le répertoire
  Set WksDest = ThisWorkbook.Sheets(1)  'feuille de destination
  Lig = WksDest.Cells(Rows.Count, 1).End(xlUp).Row + 1  '1ère ligne où commencer les transferts
  Set Obj = CreateObject("Scripting.FileSystemObject")
  Set RepP = Obj.GetFolder(Chemin)
  Set Fichier = RepP.Files
  For Each F1 In Fichier  'boucle sur tout les fichiers du répertoire
   If F1 Like Nom Then  ' recherche tout les fichiers a partir de l'étoile "*"
      Workbooks.Open F1
      'Le fichier qu'ont vient d'ouvrir est toujours le fichier actif.
      With ActiveWorkbook.Sheets(1)  'Travail avec l'index feuille et pas le nom
        For i = 1 To UBound(TB)
          WksDest.Cells(Lig, i) = .Range(TB(i))
        Next i
        'Copie pour avoir aussi le format
        '.Range("K9").Copy WksDest.Cells(Lig, i)
        'Ferme le classeur sans sauver et sans message.
        ActiveWorkbook.Close False
        Lig = Lig + 1
      End With
    End If
  Next F1
  Set RepP = Nothing
  Set Obj = Nothing
End Sub

Merci pour la rapidité de votre réponse...

j'aurais besoin que la variable NOM que vous proposé donne ceci

J'ai essayé ceci et sa fonctionne pas

Nom = Range("F4")

Nom2 = *nom.*xl* ou nom = "*"&nom&".*xl*"

If F1 Like Nom2 Then ' recherche tout les fichiers a partir de

Bonsoir

Essayes

Nom = "*" & Range("F4") & ".xls*" 

et n'utilises pas Nom2

Merci énormément de ton aide .... cela fonctionne.