Discussion :

[Marc31]

Bonjour tout le monde,

J'ai un petit soucis, car j'ai un fichier excel "premier", où je souhaite importer des données de 28 autres fichiers excels.
Mais je veux importer en fonction d'un critère. J'aimerais savoir comment je peux faire pour automatiser en vba cette tâche de copier/ coller de plusieurs classeurs sur un seul avec un critère.
Mon critère est en colonne C et c'est une valeur texte. Les 28 fichiers ont leurs premières feuilles nommées "Feuil1"

Merci et bonne soirée

[Kimy_Ire]

Il ne me semble pas que tu es répondu au dernier message.
As-tu testé ?
As-tu adapté ?

Pourquoi mettre sur le forum un nouveau post ?

Cordialement,
Kimy

[Marc31]

Alors j'ai testé mais j'ai pas réussis à adapter pour ce que je veux faire donc je viens poster un nouveau sujet pour essayer de faire étape par étape....
En premier, ouvrir plusieurs fichiers excels puis ensuite trier les données avec une condition sur chaque fichiers et enfin afficher les données dans le classeur premier.
Ce classeur rassemblerais toutes les données qui m'intéressent des autres classeurs.

[Kimy_Ire]

Alors...
1) Ceci te permet d'ouvrir de multiples fichiers Excel dans un répertoire.

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
Sub Marc31()
'Déclaration des variables
Dim myPath As String, myFile As String
 
'Ici, il faut placer le chemin du répertoire qui contient les fichiers avec l'onglet "15" 
myPath = "C:\Users\...\Desktop\test"
 
'Permet de récupérer le nom des fichiers du répertoire
myFile = Dir(myPath & "\*.*")
 
'Boucle sur l'ensemble des fichiers du répertoire
Do While myFile <> ""
    'On appelle la fonction "ClasseurOuvert" définie plus bas : elle permet de vérifier si le classeur est ouvert du répertoire. Sinon, cette fonction ouvre le classeur.
    Call ClasseurOuvert(myPath & "\" & myFile)
 
    'Avec le classeur ouvert ou qu'on vient d'ouvrir...
    With Workbooks(myFile)
 
        'Ma macro
 
        'On ferme le classeur (je l'ai commenté afin que tu puisses voir tous les classeurs ouverts)
        '.Close
    End With
    'Et on passe au suivant
    myFile = Dir()
Loop
 
End Sub
 
Function ClasseurOuvert(NomFich)
On Error Resume Next
    Workbooks(NomFich).Activate
    If Err <> 0 Then Workbooks.Open Filename:=NomFich
On Error GoTo 0
End Function

Dis-moi quand ça fonctionne.

On va faire "étape par étape"...

[Invité]

Bonjour,
Je ne sais pas si tu veux récupérer dans plusieurs onglets?
Mais tu peux utiliser la méthode ado
http://www.developpez.net/forums/d15...fichier-ferme/

[Marc31]

ça marche Nickel Kimy, merci.....
Pour la suite, j'aimerais prendre les données avec un filtre sur la colonne C de tous les fichiers ouverts.
la colonne C correspond à des VILLES mais il y a que 4 VILLES qui m'interessent dans tous les fichiers.
Donc je veux faire un critère sur la colonne C du genre Like "MONTPELLIER".
Mais je veux récupérer la ligne de la colonne A à E pour la mettre dans le fichier excel general et dans l'onglet Montpellier.
Et je souhaite que les lignes s'incrementent les unes en dessous des autres enfin si possible....
Encore merci!!!!

[kiki29]

Salut, à lire : Lire et écrire dans les classeurs Excel fermés

[Kimy_Ire]

ça marche Nickel Kimy, merci.....
Pour la suite, j'aimerais prendre les données avec un filtre sur la colonne C de tous les fichiers ouverts.
la colonne C correspond à des VILLES mais il y a que 4 VILLES qui m'interessent dans tous les fichiers.
Donc je veux faire un critère sur la colonne C du genre Like "MONTPELLIER".
Mais je veux récupérer la ligne de la colonne A à E pour la mettre dans le fichier excel general et dans l'onglet Montpellier.
Et je souhaite que les lignes s'incrementent les unes en dessous des autres enfin si possible....
Encore merci!!!!

Bonjour Marc31,

Tu parles de fichier ouvert, c'est bien... mais tu ne me dis pas quel onglet utiliser.
Est-ce celui qui commence par les deux premières chiffres du nom du classeur ? (Date du jour d'enregistrement, il me semble.)

En assumant cela, voici ce que je te propose :

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
Option Explicit
 
Sub Marc31()
Dim oWkb As Workbook
Dim oRng As Range
Dim myPath As String, myFile As String
 
Dim valeur As String, commentaire As String, com As String, champ1 As String, champ2 As String, i As Integer
 
Dim oWksh As Worksheet
 
myPath = "C:\Users\...\Desktop\test"
myFile = Dir(myPath & "\*.*")
 
Set oWkb = ThisWorkbook
'Ou
'Set oWkb = Workbooks("Le_nom_de_mon_classeur.xlsm")
 
Do While myFile <> ""
    Call ClasseurOuvert(myPath & "\" & myFile)
 
    With Workbooks(myFile)
        If FeuilleExiste(.Name, Left(myFile, 2)) Then
            With .Worksheets(Left(myFile, 2))
                'Set oRng sur C1
                Set oRng = .Range("C1")
 
                'Parcours toute les lignes de C1 à Cn avec n = dernière ligne non-vide
                For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row - 1
 
                    If oRng.Offset(i, 0) Like "MONTPELLIER" Or oRng.Offset(i, 0) Like "ma_ville_2" Then
                        'On fait un test pour savoir si le classeur oWbk contient une feuille qui s'appelle comme dans la cellule Ci (de MyFile)
                        If FeuilleExiste(oWkb.Name, oRng.Offset(i, 0)) Then
                            'Si oui, alors on insère la ligne
                            'oWkb.Worksheets(oRng.Offset(i, 0).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = oRng.Offset(i, 0).EntireRow.Value
                            oWkb.Worksheets(oRng.Offset(i, 0).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 5).Value = oRng.Offset(i, -2).Resize(1, 5).Value
                        End If
                    End If
 
                Next i
 
            End With
        End If
        .Close
    End With
    myFile = Dir()
Loop
 
End Sub
 
Function ClasseurOuvert(NomFich)
On Error Resume Next
    Workbooks(NomFich).Activate
    If Err <> 0 Then Workbooks.Open Filename:=NomFich
On Error GoTo 0
End Function
 
Function FeuilleExiste(NomClasseur As String, NomFeuille As String) As Boolean
Dim f As Object
 
On Error Resume Next
Set f = Workbooks(NomClasseur).Worksheets(NomFeuille)
 
If Err = 0 Then FeuilleExiste = True
Set f = Nothing
End Function
 
Sub save_loucinev()
'Dim Nom_fichier As String
'
'Nom_fichier = "My file"
'ActiveWorkbook.SaveAs Filename:="C:\Users\mbourgeois\Desktop\test\" & Nom_fichier
UserForm1.Show
 
End Sub
 
'Sub souhail72()
'Dim oRng As Range
'Dim oWksh As Worksheet
'Dim oLast As Integer
'Dim oCell As Range
'
'For Each oWksh In Worksheets
'    If oWksh.Name <> "Ma feuille de résultats" Then
'        With oWksh
'            oLast = WorksheetFunction.Max(.Cells(Rows.Count, 4).End(xlUp).Row, .Cells(Rows.Count, 5).End(xlUp).Row, .Cells(Rows.Count, 6).End(xlUp).Row)
'            Set oRng = .Range("D1:F" & oLast)
'            For Each oCell In oRng
'                If oCell <> 0 Then
'                    'Valeur de oCell en colonne A de ma feuille de résultats.
'                    Worksheets("Ma feuille de résultats").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = oCell
'                End If
'            Next oCell
'        End With
'    End If
'Next oWksh
'
'End Sub
 
Sub souhail72()
Dim oRng As Range
Dim oWksh As Worksheet
Dim i As Integer
 
'Parcours toutes les feuilles
For Each oWksh In Worksheets
    'Si celle-ci est différente de "Ma feuille de résultats"
    If oWksh.Name <> "Ma feuille de résultats" Then
        'On utilise la feuille
        With oWksh
            'On set la variable oRng sur G1
            Set oRng = .Range("D1")
            'Pour i = 1 jusqu'à la dernière cellule non-vide de G
            For i = 1 To .Cells(Rows.Count, 7).End(xlUp).Row - 1
                'Si Gi est différente de 0
                If oRng.Offset(i, 0) <> 0 Then
                    'On rentre dans la condition
                    'La ligne suivante recopie en dernière ligne de "Ma feuille de résultats" sur la plage de valeur A-D les valeurs contenue dans Range(.Cells(i + 1, 2), .Cells(i + 1, 5)).Value
                    'Range(.Cells(i + 1, 5), .Cells(i + 1, 8)).Value, c'est la Range à la ligne Gi et en colonne E-H (5-8)
                    Worksheets("Ma feuille de résultats").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 4).Value = Range(.Cells(i + 1, 2), .Cells(i + 1, 5)).Value
                End If
            Next i
        End With
    End If
Next oWksh
 
End Sub

N'hésite pas à revenir vers moi !

Cordialement,
Kimy

[Marc31]

Bonjour Kimy, et encore merci pour le code.
J'ai testé ça ne fonctionne pas...ils ouvrent bien tous les fichiers mais n'intègrent pas les données dans le général.
Les noms des différents fichiers sont du style pour le mois de fevrier: 01.02.2015, 02.02.2015, 03.02.2015...etc et les onglet sont presque toujours la date du jour.
C'est à dire pour le fichier 01.02.2015 c'est 01(onglet), pour le 02.02.2015 c'est 02(onglet), etc...

Cordialement,
Marc

[Invité]

Bonjour,
place un fichier source et cible en retirant les données confidentielles!

[Marc31]

Ah désolé j'ai eu un bug, je teste sur des mauvais fichiers.....ça marche super bien!!!! MERCI, vous êtes trop fort, encore merci je vais gagner pas mal de temps dans mon boulot.
Bonne journée

[Invité]

trop tard mais bon

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
Sub Test()
ImportFichier ThisWorkbook, "C:\Users\RDurupt\Desktop\TestAdo\01.01.2014.xlsx", "01"
End Sub
 
Sub ImportFichier(Classeur As Workbook, Fichier, Onglet As String)
Dim Conn As Object
Dim Sql As String
Set Conn = CreateObject("ADODB.Connection")
Dim Rs As Object
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & Fichier & ";HDR=Yes';"
Conn.Open sconnect
Set Rs = CreateObject("ADODB.Recordset")
Sql = "Select distinct  Quartier from [" & Onglet & "$A3:I48576] where Quartier  Is Not Null"
Rs.Open Sql, Conn
CReerObglet Classeur, Rs
Rs.Close
Set Rs = Nothing
Dim I As Integer
For I = 2 To Classeur.Sheets.Count
    Sql = "Select * from [" & Onglet & "$A3:I48576] where Quartier Like  '" & Classeur.Sheets(I).Name & "%'"
    Set Rs = CreateObject("ADODB.Recordset")
    Rs.Open Sql, Conn
    Titre Classeur.Sheets(I), Rs
     Classeur.Sheets(I).Range("A" & Classeur.Sheets(I).Cells.Rows.Count).End(xlUp).Offset(1).CopyFromRecordset Rs
    Rs.Close
Set Rs = Nothing
Next
sconnect.Close
Set sconnect = Nothing
End Sub
Sub Titre(Feuille As Worksheet, Rs)
Dim I As Integer
For I = 1 To Rs.fields.Count - 1
    Feuille.Range("A1").Offset(0, I) = Rs(I).Name
Next
End Sub
Sub CReerObglet(Classeur As Workbook, Rs As Object)
Dim ws As Worksheet
    While Rs.EOF = False
        If OngletExist(Classeur, Rs(0).Value) = False Then Set ws = Classeur.Sheets.Add(after:=Classeur.Worksheets(Classeur.Worksheets.Count)): ws.Name = UCase(Rs(0).Value)
    Rs.movenext
    Wend
End Sub
Function OngletExist(Classeur As Workbook, Onglet As String) As Boolean
Dim I As Long
For I = 1 To Classeur.Sheets.Count
   If UCase(Classeur.Sheets(I).Name) = UCase(Onglet) Then OngletExist = True: Exit Function
Next
End Function