Importer des données dans un fichier excel

**Marc31** · 04/03/2015, 16h38

Bonjour à tous,

Je vais essayé d'être clair....Je reçois plusieurs fichiers excels pour chaque jour du mois par exemple un fichier excel nommé 01.03.2015.xls puis 02.03.2015, etc....
Dans les fichiers il y a des noms de communes avec des informations.
J'ai crée un classeur excel nommé general avec plusieurs onglets ( commune1, commune2, commune3) pour importer les données de tous les fichiers excel dans ce classeur.
Mais en plus d'importer, il ferais un tri.
J'ai trouvé un bout de code que j'ai modifié pour faire mon truc. ça marche mais quand il trouve des valeurs, et qu'elles vont se mettre dans le fichier general, elles s'ecrasent les unes sur les autres.
Alors que je souhaite que les lignes de resultat s'incrementent les unes apres les autres

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
128
Dim wkC As Workbook ' Classeur destinataire
    Dim valeur As String, commentaire As String, com As String, champ1 As String, champ2 As String, i As Integer
 
 
 
    Set wkC = Application.Workbooks.Open("C:\Users\Desktop\02.03.2015.xlsm")
 
     For i = 4 To 18
 
 
     'Commentaire en fonction de la valeur
 
 
 
     If wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE1" Then
 
 
               ThisWorkbook.Sheets("COMMUNE1").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
             ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE2" Then
 
                ThisWorkbook.Sheets("COMMUNE2").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                    ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE3" Then
 
                       ThisWorkbook.Sheets("COMMUNE3").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                             ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE4" Then
 
                                 ThisWorkbook.Sheets("COMMUNE4").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                                     ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE5" Then
 
                                         ThisWorkbook.Sheets("COMMUNE5").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                                            ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE6" Then
 
                                                ThisWorkbook.Sheets("COMMUNE6").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                                                     ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE7" Then
 
                                                        ThisWorkbook.Sheets("COMMUNE7").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                                                             ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE8" Then
 
                                                                 ThisWorkbook.Sheets("COMMUNE8").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
    'wkDest.Close True 'Ferme en sauvant.
 
    End If
 
    Next i
 
 
 
     Set wkC = Application.Workbooks.Open("C:\Users\Desktop\02.03.2015.xlsm")
 
     For i = 4 To 18
 
 
     'Commentaire en fonction de la valeur
 
 
 
     If wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE1" Then
 
 
               ThisWorkbook.Sheets("COMMUNE1").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
             ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE2" Then
 
                ThisWorkbook.Sheets("COMMUNE2").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                    ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE3" Then
 
                       ThisWorkbook.Sheets("COMMUNE3").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                             ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE4" Then
 
                                 ThisWorkbook.Sheets("COMMUNE4").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                                     ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE5" Then
 
                                         ThisWorkbook.Sheets("COMMUNE5").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                                            ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE6" Then
 
                                                ThisWorkbook.Sheets("COMMUNE6").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                                                     ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE7" Then
 
                                                        ThisWorkbook.Sheets("COMMUNE7").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
                                                             ElseIf wkC.Sheets("15").Range("C" & i).Value Like "COMMUNE8" Then
 
                                                                 ThisWorkbook.Sheets("COMMUNE8").Range("A" & i, "F" & i).Value = wkC.Sheets("15").Range("A" & i, "F" & i).Value
 
 
    'wkDest.Close True 'Ferme en sauvant.
 
 
 
    'wkDest.Close True 'Ferme en sauvant.
 
    End If
 
    Next i
 
 
 
 
 
End Sub

**Kimy_Ire** · 04/03/2015, 16h56

Bonjour Marc31,

Bon... il y a pas mal de choses à faire !

Dans un tout premier temps, je te propose de te pencher sur la fonction Select Case. Tu trouveras de nombreux exemple sur le Web et tu comprendras vite son utilité (principalement pour ta lisibilité).

Ensuite, tu réalises deux fois la même chose : une fois avec Set wkC = Application.Workbooks.Open("C:\Users\Desktop\02.03.2015.xlsm") et une autre fois avec ton fichier daté au lendemain.
Je ne visualise pas encore bien le fonctionnel de ce que tu souhaites faire, mais je te propose, dans un second temps, de parcourir (par exemple) l'ensemble des classeurs d'un répertoire.
Tu pourras ainsi récupérer les données d'un mois complet par exemple.
Voici un petit exemple simple te permettant d'ouvrir une liste de classeur 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
Sub ListeFichiers2()
 
Dim myPath As String, myFile As String
Dim maFeuil As Worksheet
 
 
myPath = "C:\Users\...\Desktop\VBA"
myFile = Dir(myPath & "\*.*")
 
Do While myFile <> ""
    Call ClasseurOuvert(myPath & "\" & myFile)
 
    With Workbooks(myFile)
        'Je fais ce que je veux avec mon classeur maintenant ouvert
        .Close 'True (Argument "True" si sauvegarde voulue - logiquement les classeurs ouvert ne le seront qu'en lecture. Par contre la fonction fermerait les classeurs déjà ouvert sans sauvegarde. Modification possible ?)
    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

Enfin, pour résoudre ton vrai problème, tu fais ici deux boucles sur i.
Dans les deux cas, tu alimentes ThisWorkbook.Sheets("COMMUNEXX").Range("A" & i, "F" & i). Tu comprendras donc bien, qui si tu réinitialises ton i entre les deux boucles, tu replaceras les données sur la même Range.
Ainsi, je te propose d'utiliser quelque chose du genre : ThisWorkbook.Sheets("COMMUNEXX").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(x,y).
La première partie ThisWorkbook.Sheets("COMMUNEXX").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) te permet d'aller chercher la dernière cellule non-vide de ta colonne A et de prendre la cellule d'en dessous.
Ensuite le .Resize(x,y) te permet d'agrandir ta plage pour qu'elle corresponde à la Range initiale. Je te laisse insérer x et y.

Ca fait quelques éléments à faire de ton côté. Mais si tu fais tout ça, tu auras un code déjà bien meilleur !

N'hésite pas à revenir vers moi !

Cordialement,
Kimy

**Marc31** · 04/03/2015, 17h03

Merci mais je vais essayé de faire tous ça mais je ne sais pas si j'ai les compétences.....

**francis60** · 04/03/2015, 17h23

Bonjour Marc,

Il y a près de 36 000 communes françaises ...
Je te propose une boucle qui permet de balayer un tableau pour compacter un peu ton code.

Code :

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

1
2
3
4
Dim Commune as Variant
For Each Commune In Array("COMMUNE1","COMMUNE2","COMMUNE3","COMMUNE4","COMMUNEZ")
    'Ton code qui recherche la ligne vide puis reporte les données en fonction de la commune choisie.
Next

'Ou bien plus classique, mais surement moins adapté à ton cas:

Code :

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

1
2
3
4
For i = 1 To 9
    Commune = "COMMUNE" & i
    'Ton code qui recherche la ligne vide puis reporte les données en fonction de la commune choisie.
Next i

**Kimy_Ire** · 04/03/2015, 18h04

Bonjour Marc31,

Allez, j'ai fait un petit truc pour toi

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
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, "15") Then
            With .Worksheets("15")
                '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
                    '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
                    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

Alors... ce bout de code parcours tous les classeurs d'un répertoire de myPath.
Il ouvre le classeur si celui-ci n'est pas déjà ouvert.
Il vérifie si la une Feuille s'appelle "15". Si oui, il utilise la feuille.
Ensuite, il parcours la colonne C.
Pour chaque cellule, il va regarder si dans le classeur d'origine tu as une feuille du même nom (c'est tes communes).
Si tu as bien une feuille du même nom que la cellule dans la colonne C, alors tu insères la ligne dans la feuille correspondante.
Ensuite il ferme bien le classeur, et tu recommences avec le suivant.

Voila, n'hésite pas à revenir vers moi !

Cordialement,
Kimy

**Marc31** · 05/03/2015, 09h20

Bonjour, tout d'abord merci pour l'aide mais je comprends pas grand chose au code....
Comment fait-il pour ouvrir tous les fichiers excel?

Ensuite j'aimerais qu'il prenne toutes les informations dans tous les classeurs de la commune1....

**Kimy_Ire** · 05/03/2015, 10h37

Bonjour Marc31,

Alors, tu mets cette macro dans ton fichier avec tes onglets "COMMUNEXX".
Tu créés un répertoire dans lequel tu mets tous tes fichiers qui contiennent l'onglet "15" et "COMMUNEXX" dans la colonne C.

Tu mets dans "myPath" le chemin de ton répertoire et tu lances la macro.

Déjà fait cet exercice.
De mon côté, je vais commenter le code d'avantage.

Cordialement,
Kimy

EDIT :

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
Option Explicit
 
Sub Marc31()
'Déclaration des variables
Dim oWkb As Workbook
Dim oRng As Range
Dim myPath As String, myFile As String
 
'J'ai gardé les variables que tu avais insérées mais, je ne m'en sers pas. Tu peux les supprimer.
Dim valeur As String, commentaire As String, com As String, champ1 As String, champ2 As String, i As Integer
 
Dim oWksh As Worksheet
 
'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 & "\*.*")
 
'On définie oWkb comme le classeur courrant
Set oWkb = ThisWorkbook
'Ou on peut le définir de cette manière, avec son nom (plus safe, d'après moi).
'Set oWkb = Workbooks("Le_nom_de_mon_classeur.xlsm")
 
'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)
        'On appelle la fonction "FeuilleExiste" qui permet de vérifier qu'on a bien un onglet "15". Sinon, on ne fait rien.
        If FeuilleExiste(.Name, "15") Then
            'Avec la feuille "15"
            With .Worksheets("15")
                'On set la variable oRng sur C1
                Set oRng = .Range("C1")
 
                'On parcours toute les lignes de C1 à Cn avec n = dernière ligne non-vide. En bref, on lit toutes les lignes de la colonne C.
                For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row - 1
                    'On fait un test pour savoir si le classeur oWbk contient une feuille qui s'appelle comme dans la cellule Ci (de MyFile). En bref, dans les classeurs du répertoire, on regarde si les éléments des colonnes C on bien un onglet dans le classeur de synthèse.
                    If FeuilleExiste(oWkb.Name, oRng.Offset(i, 0)) Then
                        'Si oui, alors on insère la ligne ou on a trouvé "COMMUNEXX" et on la met dans le classeur de synthèse
                        oWkb.Worksheets(oRng.Offset(i, 0).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = oRng.Offset(i, 0).EntireRow.Value
                    End If
                Next i
            End With
        End If
        'On ferme le classeur
        .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
 
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

**Marc31** · 05/03/2015, 10h59

En fait j'ai plusieurs fichiers excel, l'onglet "15" n'existe qu'une fois pour le fichier du 15.03.2015 et pour le fichier du 01.03.2015, l'onglet c'est "01" et pour le fichier du 31.03.2015 c'est "31".
En fait le numéro d'onglet correspond au jour du fichier, je le reçois comme ça.....

**Kimy_Ire** · 05/03/2015, 11h16

... Je vois... Au passage ton code ne présentait trop ça...

Bref, voici :

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
Option Explicit
 
Sub Marc31()
'Déclaration des variables
Dim oWkb As Workbook
Dim oRng As Range
Dim myPath As String, myFile As String
 
'J'ai gardé les variables que tu avais insérées mais, je ne m'en sers pas. Tu peux les supprimer.
Dim valeur As String, commentaire As String, com As String, champ1 As String, champ2 As String, i As Integer
 
Dim oWksh As Worksheet
 
'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 & "\*.*")
 
'On définie oWkb comme le classeur courrant
Set oWkb = ThisWorkbook
'Ou on peut le définir de cette manière, avec son nom (plus safe, d'après moi).
'Set oWkb = Workbooks("Le_nom_de_mon_classeur.xlsm")
 
'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)
        'On appelle la fonction "FeuilleExiste" qui permet de vérifier qu'on a bien un onglet du jour. Sinon, on ne fait rien.
        If FeuilleExiste(.Name, Left(myFile, 2)) Then
            'Avec la feuille du jour
            With .Worksheets(Left(myFile, 2))
                'On set la variable oRng sur C1
                Set oRng = .Range("C1")
 
                'On parcours toute les lignes de C1 à Cn avec n = dernière ligne non-vide. En bref, on lit toutes les lignes de la colonne C.
                For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row - 1
                    'On fait un test pour savoir si le classeur oWbk contient une feuille qui s'appelle comme dans la cellule Ci (de MyFile). En bref, dans les classeurs du répertoire, on regarde si les éléments des colonnes C on bien un onglet dans le classeur de synthèse.
                    If FeuilleExiste(oWkb.Name, oRng.Offset(i, 0)) Then
                        'Si oui, alors on insère la ligne ou on a trouvé "COMMUNEXX" et on la met dans le classeur de synthèse
                        oWkb.Worksheets(oRng.Offset(i, 0).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = oRng.Offset(i, 0).EntireRow.Value
                    End If
                Next i
            End With
        End If
        'On ferme le classeur
        .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
 
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

**Marc31** · 06/03/2015, 16h43

J'arrive pas à adapter le code pour ma situation car déjà toutes les feuilles des différents classeurs sont différentes.

**Kimy_Ire** · 06/03/2015, 16h54

Une automatisation est, par définition, une action permettant d'effectuer des tâches répétitives de manière rapide.

Ainsi, si tous tes classeurs ont des onglets, colonnes, valeurs, formalismes différents, il va peut-être être difficile de faire une macro.

Je te propose d'exposer CLAIREMENT ce que tu veux faire.
Par exemple :

Je parcours tous les classeurs de mon répertoire
J'ouvre chaque classeur
Je cherche la feuille intitulé "abc"
Je vais en colonne C
Sur cette colonne on trouve dans chaque cellule le nom d'un onglet de mon classeur original
Je souhaiterai rapatrier la ligne entière dans l'onglet concerné (en fonction de la valeur dans C) dans mon fichier original
etc...

Je pense, en fait, que tu ne sais pas trop, toi non plus, ce que tu veux faire.

Je ne perdrais plus de temps si ton énoncé n'est pas explicite...

Cordialement,
Kimy

Importer des données dans un fichier excel

Macros et VBA Excel

Discussions similaires

Partager

Partager