Inserer un variable a partir d'une cellule dans mon code VBA [Fermé]

Signaler
Messages postés
5
Date d'inscription
samedi 27 juillet 2013
Statut
Membre
Dernière intervention
27 octobre 2014
-
Messages postés
1412
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
9 mars 2021
-
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

1 réponse

Messages postés
1412
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
9 mars 2021
151
Bonsoir Schoret, bonsoir le forum,

Peut-être en remplaçant :
If F1 Like "*" Then

par :
If F1.Name Like "*" & Range("F4").Value & ".xlsx" Then