Bonjour,

La macro que j'ai fonctionne en pas à pas (c'est à dire en appuyant sur F8)= ligne par ligne) mais pas en la lançant d'un coup à partir d'un fichier générateur.

Son but :
  • Parcourir tous les fichiers d'un dossier renseigné en début de macro
  • Parcourir tous les onglets de ces fichiers
  • Y chercher le mot "annulation" (pour trouver la ligne d’entête du fichier - qui n'est pas forcément toujours sur la même ligne)
  • puis parcourir toutes les lignes inférieures à la ligne d’entête.
  • Chercher si la colonne "annulation" a des occurrences
  • copier la ligne entière vers un fichier vierge


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
60
61
62
63
64
65
66
67
68
    Chemin = InputBox("saisir le chemin", "Saisie du répertoire")
 
    If Right(Chemin, 1) <> "\" Then
        Chemin = Chemin & "\"
    End If
 
 
    'appel de la fonction avec le chemin du dossier (adapter...)
    Tablo = RecupFichiers(Chemin)
 
    'si au moins un fichier trouvé...
    If Not (Not Tablo) Then
 
        'Workbooks.Add
        Set Fichier_Final = Workbooks.Add
        Ligne_Fichier_Final = 2
        For i = 1 To UBound(Tablo)
 
            'ouvre le classeur...
            Set Cls = Workbooks.Open(Chemin & Tablo(i), UpdateLinks:=False)
 
            'parcours sa collection de feuilles...
            For Each Feuille In Cls.Worksheets
                    Set c = Feuille.Range("A1:ZZ10").Find("Annulation", LookIn:=xlValues)
                    If Not c Is Nothing Then
                        For Ligne_Fichier_Source = c.Row + 1 To Feuille.Range("A" & Rows.Count).End(xlUp).Row
                            If Feuille.Cells(Ligne_Fichier_Source, c.Column) <> "" Then
                                Cls.Feuille.Range(Rows(Ligne_Fichier_Source), Rows(Ligne_Fichier_Source)).Copy
                                Fichier_Final.Sheets(1).Cells(Ligne_Fichier_Final, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                                Ligne_Fichier_Final = Ligne_Fichier_Final + 1
                            End If
                        Next Ligne_Fichier_Source
 
                    End If
            Next Feuille
 
            'referme le classeur
            Application.CutCopyMode = False
            Cls.Close SaveChanges:=False
 
        Next i
 
    End If
    Application.DisplayAlerts = False
 
End Sub
 
Function RecupFichiers(Chemin As String) As String()
 
    Dim Tbl() As String
    Dim Fichier As String
    Dim i As Integer
 
    'seulement les fichiers .xlsx
    Fichier = Dir(Chemin & "*.xlsx")
 
    Do While (Len(Fichier) > 0)
 
        i = i + 1
        ReDim Preserve Tbl(1 To i)
        Tbl(i) = Fichier
        Fichier = Dir()
 
    Loop
 
    RecupFichiers = Tbl()
 
End Function
Vous avez une idée d’où vient le problème?