Discussion :

[Guizmal]

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

[BENNASR]

Bonsoir
pour annuler les filtres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each sh In Sheets
    sh.ShowAllData
Next sh

[Guizmal]

Bonsoir
pour annuler les filtres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each sh In Sheets
    sh.ShowAllData
Next sh

Bonjour BENNSAR,

Merci pour ta réponse rapide mais cela ne répond pas à ma problématique.
Pour pouvoir lancer cette ligne de code, il faut que les X fichiers XLS sources soient ouverts dans l'application excel.
Mon code permet de ne pas avoir à ouvrir X fois les fichiers XLS sources.

Je pense que la solution est dans l'utilisation de la connection ADODB...

[BENNASR]

pour moi comme débutant VBA et pour faire comparaison entre les données d'un classeur ouvert et des données d'un classeur fermé (faire comparaison et/ou importer des données je fais avec
réponse que j'ai donné à cette discussion d'aujrd'hui :

https://www.developpez.net/forums/d1...-d-classeur-l/

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
Option Explicit
Sub chercherValeur()
Application.ScreenUpdating = False
Dim Trouve As Range, Plage As Range
Dim Valeur_Cherchee As String, cel As Range
Dim wkA As Workbook, wkB As Workbook
Dim chemin As String, fichier As String
Dim j As Long
Application.ScreenUpdating = False
Set wkA = ThisWorkbook
chemin = "C:\Users\DELL\Desktop\développement Excel\"
fichier = "adresse dossier.xlsm"
Workbooks.Open chemin & fichier
Set wkB = ActiveWorkbook
Set Plage = wkB.Sheets("Feuil2").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
wkA.Activate
For Each cel In wkA.Sheets("F03").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
 Valeur_Cherchee = cel.Value
 Set Trouve = Plage.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
  If Trouve Is Nothing Then
     Cells(cel.Row, 2) = Valeur_Cherchee & " n'est pas présent dans F1  " & Plage.Address
  Else
    Cells(cel.Row, 2) = "valeur Existe  en  " & Trouve.Address
  End If
Next cel
wkB.Close True
Set Plage = Nothing
Set Trouve = Nothing
Application.ScreenUpdating = True
End Sub