Bonjour à tous,

Le code ci-dessous permet de compiler X fichiers XLS sources en un seul fichier XLS avec X onglets.
Mon problème :
Cela ne fonctionne pas lorsque les fichiers sources sont enregistrés avec un filtre...
Je ne peux pas enlever les filtres en amont, ce sont des fichiers sources générés en auto par mon système d'informations.

Merci pour votre aide précieuse ,

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
Option Explicit
 
Sub Macro_principale()
'Déclaration des variables
Dim Nom_fichier As String
Dim Wh_source As String
Dim Feuille As Worksheet
 
 
For Each Feuille In ThisWorkbook.Worksheets
    'nom feuille
    Nom_fichier = Feuille.Name
 
    If Nom_fichier <> "Synthèse" Then
 
        'suppression données
        Feuille.Cells.Delete Shift:=xlUp
 
        'Récupérer données
        Wh_source = ThisWorkbook.Path & "\" & Nom_fichier & ".xlsx"
        Call lire_fichier_ferme(Wh_source, "Lokad", ThisWorkbook.Name, Nom_fichier)
    End If
 
Next Feuille
 
MsgBox ("La mise à jour a été faite")
 
End Sub
 
Private Sub lire_fichier_ferme(Fichier_source As String, Feuille_source As String, Fichier_cible As String, Feuille_cible As String)
 
Dim Cn As ADODB.Connection
Dim Table_SQL As Variant
Dim Rst As ADODB.Recordset
 
'Définit le classeur fermé servant de base de données
Set Cn = New ADODB.Connection
 
'--- Connection ---
With Cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier_source & ";Extended Properties=""Excel 12.0;HDR=NO;;IMEX=1;"";"
    .Open
End With
'-----------------
 
'Définit la requête
'/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
Table_SQL = "SELECT * FROM [" & Feuille_source & "$]"
 
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(Table_SQL)
 
'Ecrit le résultat de la requête dans la cellule A1
With Workbooks(Fichier_cible).Worksheets(Feuille_cible)
    .Cells.Clear
    .Range("A1").CopyFromRecordset Rst
End With
 
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
 
End Sub