Compilation de données Excel

Version imprimable

05/02/2011, 22h41
azsdcv

Compilation de données Excel

Bonjour à tous,

Je souhaiterai rassembler des données située dans plusieurs fichiers Excel dans un seul et unique fichier Excel. En effet, l'ouverture "manuel" de plusieurs fichiers Excel et les copier coller dans un seul fichier est extrêmement long.

Je souhaiterai donc créer une macro qui :
- dès l'ouverture du fichier Excel demande de sélectionner un autre fichier Excel
- puis me redemande si je veux ouvrir un autre fichier Excel
- pour arriver au fichier Excel regroupant les données des autre fichiers Excel

Un fichier Excel de donnée se compose de 5 colonnes A,B,C,D et E, avec un nombre de ligne variable suivant le fichier

Est-il possible de réaliser se genre de macro sans procéder à l'ouverture des fichiers Excel ?

D'avance merci pour vos réponses :ccool:

Cordialement,

azsdcv

Bonjour
Une proposition de code que tu mets dans un module, tu lance le code qui te demande d'ouvrir ton premier fichier et qui le colle dans l'onglet 2, puis te demande d'ouvrir ton deuxième fichier et qui le colle dans ton onglet 3, ensuite tu continues et tu en fait ce que tu souhaites.

Code:

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
Sub Module01_Import()
 
Set Destination = ActiveWorkbook
 
Dim Msg, Style, Title, Help, Ctxt, Response, MyString, Msg1, Style1, Title1, Help1, Ctxt1, Response1, MyString1
Msg = "Ouvrir le fichier  'Au choix'?"
Style = vbYesNo + vbDefaultButton1
Title = "Ouverture du fichier source"
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
 
If Response = vbYes Then
    MyString = "Yes"
 
            Source = Application.Dialogs(xlDialogOpen).Show
            If Source = False Then
            MsgBox ("Aucun fichier sélectionné")
            Exit Sub
            Else
            Set Source = ActiveWorkbook
 
 
            Source.Activate
            Sheets(1).Select
            Cells.Select 'Feuille entièrement sélectionnée
            Selection.Copy
 
            Destination.Activate 'Fichier Onglet activé
            Sheets(2).Select 'Onglet activé
            Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues 'Collage spécial valeurs
 
            Source.Activate 'Fichier sélectionné activé
            Application.CutCopyMode = False
            ActiveWindow.Close SaveChanges:=False 'Fichier sélectionné fermé
            End If
 
Else
MyString = "No"
MsgBox ("Aucun fichier sélectionné")
 
Exit Sub
 
End If
 
 
    Call Module01Import2 'pour passer directement au deuxième import
 
End Sub
 
 
Sub Module01Import2()
 
 
Set Destination = ActiveWorkbook
 
Dim Msg, Style, Title, Help, Ctxt, Response, MyString, Msg1, Style1, Title1, Help1, Ctxt1, Response1, MyString1
Msg = "Ouvrir le fichier 'Au choix'?"
Style = vbYesNo + vbDefaultButton1
Title = "Ouverture du fichier source"
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
 
If Response = vbYes Then
    MyString = "Yes"
 
            Source = Application.Dialogs(xlDialogOpen).Show
            If Source = False Then
            MsgBox ("Aucun fichier sélectionné")
            Exit Sub
            Else
            Set Source = ActiveWorkbook
 
            Source.Activate
            Sheets(1).Select
            Cells.Select 'Feuille entièrement sélectionnée
            Selection.Copy
 
            Destination.Activate 'Fichier Onglet activé
            Sheets(3).Select 'Onglet activé
            Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues 'Collage spécial valeurs
 
            Source.Activate 'Fichier sélectionné activé
            Application.CutCopyMode = False
            ActiveWindow.Close SaveChanges:=False 'Fichier sélectionné fermé
 
            End If
 
Else
MyString = "No"
MsgBox ("Aucun fichier sélectionné")
 
Exit Sub
 
End If
 
 
'Call ModuleAFairePourLaSuite
 
 
 
End Sub

Cordialement

Bonsoir,

Sans ouvrir les classeurs (ADO) mais en indiquant le chemin de chacun. L'arrêt de la proc se fait quand plus aucun choix n'est réalisé.
A mettre dans un module standard :

Code:

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
 
Private Sub ConnectCLasseur(ConnectCL As Object, _
                            Fichier As String, _
                            Optional Rs)
 
    Set ConnectCL = CreateObject("ADODB.Connection")
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
    ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 2;"""
 
End Sub
 
Sub RetourPlage()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Champ As Object
    Dim Tableau
    Dim Classeur As String
    Dim NomFeuille As String
    Dim Plage As String
    Dim I As Integer, J As Integer
 
    'si une erreur survient
    On Error GoTo FIN
 
    'chemin du classeur cible
    Do
 
    Classeur = Application.GetOpenFilename
 
    'si un choix à été fait
    If Classeur <> CStr(False) Then
 
        'nom de la feuille où s'effectue la récup, à adapter
        NomFeuille = "Feuil1"
 
        'toutes les cellules des colonnes A à E
        Plage = "A1:E65536"
 
        'connecte le classeur
        ConnectCLasseur ConnectCL, Classeur, Rs
 
        With Rs
 
            'récupère les valeurs dans le classeur
            .CursorType = 1
            .LockType = 3
            .Open "SELECT * FROM `" & NomFeuille & "$" & _
            Plage & "` ", ConnectCL
 
            'mets les valeurs dans un tableau (plus rapide)
            .MoveFirst
 
            ReDim Tableau( _
                1 To .RecordCount, _
                1 To .Fields.Count)
 
            .MoveFirst
 
            Do While Not .EOF
 
                I = I + 1
 
                For Each Champ In .Fields
 
                    J = J + 1
                    Tableau(I, J) = Champ.Value
 
                Next
 
                J = 0
 
                .MoveNext
 
            Loop
 
            I = 0
 
        End With
 
        'ajoute une nouvelle feuille et colle les valeurs
        'àpartir de A1
        With ThisWorkbook.Worksheets.Add
 
            .Range(.[A1], .Cells(UBound(Tableau, 1), _
            UBound(Tableau, 2))).Value = Tableau
 
        End With
 
        Erase Tableau
 
        ConnectCL.Close
 
    End If
 
    'boucle aussi longtemps qu'un choix est fait
    Loop Until Classeur = CStr(False)
 
    Set Rs = Nothing
    Set ConnectCL = Nothing
 
    Exit Sub
 
FIN:
    MsgBox "Une erreur est survenue lors de la récupération des valeurs du classeur '" & Classeur & "' !"
 
End Sub

A mettre dans le module du ThisWorkbook pour un lancement de la récup à l'ouverture du classeur :

Code:

1
2
3
4
5
6
 
Private Sub Workbook_Open()
 
    RetourPlage
 
End Sub

Hervé.

06/02/2011, 18h52
Vadorblanc

Bonjour
These, je viens de tester ta boucle qui fonctionne très bien et que je vais surement utiliser, beau travail, avec toutes les explications, de plus on a le choix aussi d'ouvrir des fichiers CSV, un grand merci.
Bien cordialement
06/02/2011, 22h21
azsdcv

Theze,

La macro que tu m'as proposer ne fonctionne pas. les fichiers que je souhaiterai regroupés sur une seule feuille d'un fichier Excel sont des .CSV

En effet les .XLS fonctionne très bien mais le message d'erreur apparait lorsque j'ouvre un .CSV

Est-il possible d'ajouter les valeurs des lignes copier sur une même feuille à la suite des autres valeurs ?

Encore Merci

azsdcv

Bonsoir,

La connexion est un peu différente pour un csv. Ci-dessous le code retouché. Les données sont maintenant misent les unes à la suite des autres dans la feuille active. Adapte le séparateur (dans l'exempe le ";" est utilisé). Reviens si ça ne va pas :

Code:

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
 
Private Sub ConnectCLasseur(ConnectCL As Object, _
                            Fichier As String, _
                            Optional Rs)
 
    Set ConnectCL = CreateObject("ADODB.Connection")
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
    ConnectCL.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
                   "Dbq=" & Fichier & ";" & _
                   "Extensions=asc,csv,tab,txt;"
 
End Sub
 
Sub RetourPlage()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Champ As Object
    Dim Tableau
    Dim TblSplit
    Dim Chemin As String
    Dim Classeur As String
    Dim Dossier As String
    Dim I As Integer, J As Integer, K As Integer
    Dim DerCel As Long
 
    'si une erreur survient
    On Error GoTo FIN
 
    Do
 
    'chemin du classeur cvs cible
    Chemin = Application.GetOpenFilename("Fichiers csv (*.csv), *.csv")
 
    'si un choix à été fait
    If Chemin <> CStr(False) Then
 
        'isole le nom du classeur
        Classeur = Right(Chemin, Len(Chemin) - InStrRev(Chemin, "\"))
 
        'recupère le dossier où est stocké le classeur
        Dossier = Left(Chemin, InStrRev(Chemin, "\"))
 
        'connecte le classeur
        ConnectCLasseur ConnectCL, Dossier, Rs
 
        With Rs
 
            'récupère les valeurs dans le classeur
            .CursorType = 1
            .LockType = 3
            .Open "SELECT * FROM " & Classeur, ConnectCL
 
            'mets les valeurs dans un tableau (plus rapide)
            .MoveFirst
 
            ReDim Tableau(1 To .RecordCount, 1 To 5)
 
            .MoveFirst
 
            Do While Not .EOF
 
                I = I + 1
 
                'splite l'enregistrement, adapter le séparateur (ici, le point virgule)
                TblSplit = Split(.Fields(0).Value, ";")
 
                'tranfère chaque valeur dans le tableau
                For K = 0 To UBound(TblSplit)
 
                    J = J + 1
                    Tableau(I, J) = TblSplit(K)
 
                Next
 
                J = 0
 
                .MoveNext
 
            Loop
 
            I = 0
 
        End With
 
        'colle les valeurs dans la feuille active à partir de la première cellule vide de la colonne A
        With ThisWorkbook.ActiveSheet
 
            'recherche la dernière cellule non vide, si DerCel=2 alors A1 est vide donc DerCel=1
            DerCel = .[A65536].End(xlUp).Row + 1: If DerCel = 2 Then DerCel = 1
 
            .Range(.Cells(DerCel, 1), .Cells(UBound(Tableau, 1) - 1 + DerCel, _
                   UBound(Tableau, 2))).Value = Tableau
 
        End With
 
        Erase Tableau
 
        ConnectCL.Close
 
    End If
 
    'boucle aussi longtemps qu'un choix est fait
    Loop Until Chemin = CStr(False)
 
    Set Rs = Nothing
    Set ConnectCL = Nothing
 
    Exit Sub
 
FIN:
    MsgBox "Une erreur est survenue lors de la récupération des valeurs du classeur '" & Classeur & "' !"
 
End Sub

Hervé.

09/02/2011, 21h20
azsdcv

Hervé,

Cette macro ne fonctionne pas, il m'affiche un message d'erreur.
Est-il possible de garder chacune des mesures dans leur cellule au lieu de les séparer par ; ?
Je souhaiterai par la suite exploiter ces donnée avec un graphique.

Merci pour votre aide
Thomas
09/02/2011, 21h55
Vadorblanc

Bonjour azsdcv
As tu essayé d'ouvrir un fichier CSV en passant directement par Excel, personnellement à partir de la version Excel 2003, j'ouvre directement les fichiers CSV avec l'ascenseur Excel à l'ouverture par "Type de fichiers", puis sélection "Tous les fichiers" car les fichiers CSV n'apparaissent pas par défaut quand Excel est ouvert, puis ton fichier CSV ouvert, tu vois qu'Excel supprime les point virgules et mets les valeurs dans les colonnes directement, ensuite tu peux travailler ce fichier facilement.
Le version Excel 2002 ne le fait pas.
Cordialement
10/02/2011, 12h42
azsdcv

Citation:

Envoyé par Vadorblanc

Bonjour azsdcv
As tu essayé d'ouvrir un fichier CSV en passant directement par Excel, personnellement à partir de la version Excel 2003, j'ouvre directement les fichiers CSV avec l'ascenseur Excel à l'ouverture par "Type de fichiers", puis sélection "Tous les fichiers" car les fichiers CSV n'apparaissent pas par défaut quand Excel est ouvert, puis ton fichier CSV ouvert, tu vois qu'Excel supprime les point virgules et mets les valeurs dans les colonnes directement, ensuite tu peux travailler ce fichier facilement.
Le version Excel 2002 ne le fait pas.
Cordialement

L'ouverture du fichier CSV en lui même ne pose pas de problème. C'est l'ouverture d'un .CSV avec la macro qui ne fonctionne pas.

Cordialement,

azsdcv
10/02/2011, 18h43
Vadorblanc

Bonjour azsdcv
Effectivement le code proposé par Theze ne fonctionne pas, même si j'ai cru au départ que c'était possible car à son lancement les fichiers CSV sont bien visibles, j'attendais qu'il le modifie ou qu'un expert prenne le relais car c'est un code qui m'interesse aussi.
Si tu trouves que l'ouverture d'un fichier avec Excel ne te pose pas de problème, pourquoi n'utilises tu as le code que je t'ai fourni, car c'est de cette façon que je procède pour les fichiers CSV en attendant...qu'un pro...nous montre ses talents...et ils en ont...c'est sûr...
Cordialement

Bonjour azsdcv
Puisque tu n'as pas de réponse, je te mets mon code, même s'il n'est pas beau, pour moi il fonctionne et charge en pointant autant de fichiers CSV que tu lanceras le code en compilant dans l'onglet 2 tous les fichiers transformés en Excel. Supprime les selects s'ils te gêne.
Cordialement

Code:

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
Sub Module01_Import()
 
Set Destination = ActiveWorkbook
 
Dim Msg, Style, Title, Help, Ctxt, Response, MyString, Msg1, Style1, Title1, Help1, Ctxt1, Response1, MyString1
Msg = "Ouvrir le fichier  'Au choix'?"
Style = vbYesNo + vbDefaultButton1
Title = "Ouverture du fichier source"
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
 
If Response = vbYes Then
    MyString = "Yes"
 
            Source = Application.Dialogs(xlDialogOpen).Show
            If Source = False Then
            MsgBox ("Aucun fichier sélectionné")
            Exit Sub
            Else
            Set Source = ActiveWorkbook
 
 
            Source.Activate
            Sheets(1).Select
            Cells.Select 'Feuille entièrement sélectionnée
            Selection.Copy
 
            Destination.Activate 'Fichier Onglet activé
            Sheets(1).Select 'Onglet activé
            Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues 'Collage spécial valeurs
 
            Source.Activate 'Fichier sélectionné activé
            Application.CutCopyMode = False
            ActiveWindow.Close SaveChanges:=False 'Fichier sélectionné fermé
            End If
 
Else
MyString = "No"
MsgBox ("Aucun fichier sélectionné")
 
Exit Sub
 
End If
 
 
     Sheets(1).Select
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True
    Range("A1").Select
 
 
    Sheets(1).Select
 
    Selection.CurrentRegion.Select
    Selection.Copy
    Sheets(2).Select
 
    'Toutes versions Excel
    Cells(Rows.Count, 1).End(xlUp).Select
 
    ActiveSheet.Paste
    Range("A1").Select
    Sheets(1).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
 
End Sub

11/02/2011, 07h38
Theze

Bonjour,

Je viens de tester mon code et il fonctionne très bien sur plusieurs fichiers .csv.
Qu'el est ton séparateur ?
Le code est construit pour récupérer les valeurs sur 5 colonnes comme demandé dans ton message initial.
Ouvre ton fichier avec le bloc note pour voir et tiens moi au courant.

Hervé.
14/02/2011, 12h20
azsdcv

Citation:

Envoyé par Theze

Bonjour,

Je viens de tester mon code et il fonctionne très bien sur plusieurs fichiers .csv.
Qu'el est ton séparateur ?
Le code est construit pour récupérer les valeurs sur 5 colonnes comme demandé dans ton message initial.
Ouvre ton fichier avec le bloc note pour voir et tiens moi au courant.

Hervé.

Theze,

La macro arrive à ouvrir le .CSV mais les données ne sont pas affiché sur les 5 colonnes. Elles sont séparées par ";". Si je veux ouvrir un deuxième fichier .CSV il m'affiche un message d'erreur.

J'ai joint un des .CSV en copie du mail

Merci

Azsdcv