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 51 52 53 54 55 56 57 58 59
| Sub FindTable(ByVal Sh As Worksheet, ByVal PathTracker As String)
Dim WorkFile As Worksheet
Dim CellFind As Range
Dim RefCell As String
Dim TableFind As Range
Dim Ln As Integer
Dim NombreVal As Integer
Dim PositionBatch As Integer
Dim NameTracker As String
'Séparer nom du fichier
PositionBatch = InStr(PathTracker, "AAA")
NameBatch = Mid(PathTracker, PositionBatch, 10)
path = ThisWorkbook.path
Set Sh2 = ThisWorkbook.Sheets("2-" & NameBatch)
Position = InStr(PathTracker, "Tracker")
NameTracker = Mid(PathTracker, Position)
Dim PathFile As String
Dim NameFile As String
Dim Position2 As Integer
Position2 = InStr(PathTracker, "\Tracker")
PathFile = Mid(PathTracker, Position2)
NameFile = Mid(PathTracker, 1, Position2 - 1)
Dim Dossier As String
'Ouvre fichier Tracker
Workbooks.Open (path & PathTracker)
Set WorkFile = Workbooks(NameTracker).Worksheets("Completed PrC")
'Cellule de référence à rechercher
RefCell = "Today date"
NombreVal = 1
Ln = 0
'Recherche cellule de référence
Set CellFind = WorkFile.Cells.Find(RefCell, LookIn:=xlValues, SearchOrder:=xlByRows)
'Compte le nombre de lignes non-vides en dessous de la cellule de référence = Ln
Do While NombreVal > 0
Ln = Ln + 1
NombreVal = WorkFile.Application.WorksheetFunction.CountA(Rows(CellFind.Row + Ln))
Loop
'Crée un tableau avec les lignes en dessous de la cellule de référence
Set TableFind = WorkFile.Cells(CellFind.Row + 1, 1).Resize(Ln, 1).EntireRow
'Affiche tableau sur feuille Classeur_source
TableFind.Copy Sh.Cells(1, 1)
Sh2.Cells.Clear
'Appelle fonction filtre tableau
DeleteColumns Sh2, TableFind, PathTracker
'Ferme fichier Tracker
Workbooks(NameTracker).Close
End Sub |
Partager