Bonjour,

J'ai un fichier "travail" qui contient un tableau récapitulatif avec certaines cellules contenant des formules CountIfs.
Mon programme récupère ce tableau et le colle dans un autre fichier "source".

Ce programme copie/colle bien les cellules sans formule, mais pour les cellules avec formule, il affiche "0" dans mon fichier "source"

Voici ma fonction, qui à partir du chemin donné récupère le tableau :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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