inserer une variable a partir d'une cellule dans mon code VBA / EXCEL 2013
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 ...
-----------------------------------------------------------------------------------------------------
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
| 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 |
