écriture dans excel à partir d'un fichier CSV

Version imprimable

Je suis débutante en vba et mon objectif est de parcourir un répertoire contenant uniquement des fichiers CSV , effectuer la lecture des fichiers et de écrire les données de l'ensemble des fichiers CSV dans une feuille excel.
Voici le code permettant de parcourir le répertoire et de récupérer les données du fichier csv. Par contre, je n'arrive pas à avoir des idées pour l'écriture dans excel. Si quelqu'un pourrait me renseigner, je le remercie énormèment car je galère en ce moment.

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
 
Sub ParcourirRepertoire()
 
    Dim stRep
    Dim oFSO, oFl, f, Nom_Fichier, chaine, fso, fCsv, tb
    Const ForReading = 1
 
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    stRep = "C:\Documents and Settings\kmakhtas\Bureau\OperateursGestform\"
 
    If oFSO.FolderExists(stRep) Then
        For Each oFl In oFSO.GetFolder(stRep).Files
 
            Set fCsv = oFSO.openTextFile(stRep & oFl.Name, ForReading)
            If Not fCsv.AtEndOfStream Then fCsv.ReadLine
            While Not fCsv.AtEndOfStream
                tb = Split(fCsv.ReadLine, ";")
                If UBound(tb) = 6 Then
                    MsgBox "Date : " & tb(0) & vbCrLf & "Heure début : " & tb(1) & vbCrLf & "Heure Fin : " & tb(2) & vbCrLf & "Login : " & tb(3) & vbCrLf & "Activité : " & tb(4) & vbCrLf & "Degré Urgence : " & tb(5) & vbCrLf & "Avec ou sans Diffusion : " & tb(6)
                End If
            Wend
        Next
    End If
 
End Sub

Je vous remercie d'avance pour toute aide.

Aquarium33

14/02/2012, 12h44
BlueMonkey

Bonjour,

A mon idée, il serait plus simple d'ouvrir le fichier csv directement dans un classeur.

Code:

Workbooks.Open FileName:="<nom du fichier>.csv"

Puis de copier toutes les feuilles (1 par fichier .csv) dans un classeur, ou bien les regrouper par copie de données.

L'intérêt est qu'il n'y a pas décodage des séparateurs de liste ";".
Excel mettra dans une cellule différente chaque élément séparé par un ";".

Bonjour,

Une proposition pour écriture de chaque lignes dans la colonne A de la Feuille "FeuilleDestination"

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
 
Sub ParcourirRepertoire()
 
Dim stRep
Dim oFSO, oFl, f, Nom_Fichier, chaine, fso, fCsv, tb
Const ForReading = 1
 
Dim Sh As Worksheet
Dim Ligne As Long
 
Set Sh = Worksheets("FeuilleDestination")
Ligne = Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRep = "C:\Documents and Settings\kmakhtas\Bureau\OperateursGestform\"
 
If oFSO.FolderExists(stRep) Then
 
    For Each oFl In oFSO.GetFolder(stRep).Files
 
        Set fCsv = oFSO.openTextFile(stRep & oFl.Name, ForReading)
 
        If Not fCsv.AtEndOfStream Then fCsv.ReadLine
 
        While Not fCsv.AtEndOfStream
            tb = Split(fCsv.ReadLine, ";")
                If UBound(tb) = 6 Then
                    Sh.Range("A" & Ligne).Value = "Date : " & tb(0) & vbCrLf & "Heure début : " & tb(1) & vbCrLf & "Heure Fin : " & tb(2) & vbCrLf & "Login : " & tb(3) & vbCrLf & "Activité : " & tb(4) & vbCrLf & "Degré Urgence : " & tb(5) & vbCrLf & "Avec ou sans Diffusion : " & tb(6)
                    Ligne = Ligne + 1
                End If
        Wend
 
    Next
 
End If
 
End Sub

14/02/2012, 13h15
Aquarium33

Tout d'abord je vous remercie pour votre réponse.

Oui, j'ai déjà fait ça pour un seul fichier CSV, seulement le nombre des fichiers correspond à l'ensemble des employés de l'entreprise (soit environ 300 personnes).
C'est pour cette raison que j'aimerais bien savoir si je pourrais utiliser du code vba pour réaliser votre solution qui me paraît la plus simple:

"copier toutes les feuilles (1 par fichier .csv) dans un classeur, ou bien les regrouper par copie de données."

Existe-t-il d'autres solutions ?

Merci pour votre aide

Aquarium33

écriture d'un fichier CSV vers Excel

Bonjour,

Je vouis remercie pour votre aide. j'ai fini par trouver la solution à mon problème.
Voici le code correspond; j'espère qu'il servira pour d'autres débutants en programmation.

Voici le code correspondant :

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
 
Option Explicit
 
Sub ParcourirRepertoire()
 
Dim stRep
Dim oFSO, oFl, f, Nom_Fichier, chaine, fso, fCsv, tb
Const ForReading = 1
 
Dim Sh As Worksheet
Dim LigneA As Long
Dim ColonneA As Long
Dim LigneB As Long
Dim ColonneB As Long
Dim LigneC As Long
Dim ColonneC As Long
Dim LigneD As Long
Dim ColonneD As Long
Dim LigneE As Long
Dim ColonneE As Long
Dim LigneF As Long
Dim ColonneF As Long
Dim LigneG As Long
Dim ColonneG As Long
 
Set Sh = Worksheets("Feuil16")
LigneA = Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
ColonneA = Sh.Range("A" & Columns.Count).End(xlToRight).Column + 1
LigneB = Sh.Range("B" & Rows.Count).End(xlUp).Row + 1
ColonneB = Sh.Range("B" & Columns.Count).End(xlToRight).Column + 1
LigneC = Sh.Range("C" & Rows.Count).End(xlUp).Row + 1
ColonneC = Sh.Range("C" & Columns.Count).End(xlToRight).Column + 1
LigneD = Sh.Range("D" & Rows.Count).End(xlUp).Row + 1
ColonneD = Sh.Range("D" & Columns.Count).End(xlToRight).Column + 1
LigneE = Sh.Range("E" & Rows.Count).End(xlUp).Row + 1
ColonneE = Sh.Range("E" & Columns.Count).End(xlToRight).Column + 1
LigneF = Sh.Range("F" & Rows.Count).End(xlUp).Row + 1
ColonneF = Sh.Range("F" & Columns.Count).End(xlToRight).Column + 1
LigneG = Sh.Range("G" & Rows.Count).End(xlUp).Row + 1
ColonneG = Sh.Range("G" & Columns.Count).End(xlToRight).Column + 1
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRep = "C:\Documents and Settings\kmakhtas\Bureau\OperateursGestform\"
 
If oFSO.FolderExists(stRep) Then
 
For Each oFl In oFSO.GetFolder(stRep).Files
 
Set fCsv = oFSO.openTextFile(stRep & oFl.Name, ForReading)
 
If Not fCsv.AtEndOfStream Then fCsv.ReadLine
 
While Not fCsv.AtEndOfStream
tb = Split(fCsv.ReadLine, ";")
If UBound(tb) = 6 Then
Sh.Range("A" & LigneA).Value = tb(0)
Sh.Range("A" & ColonneA).Value = tb(0)
LigneA = LigneA + 1
ColonneA = ColonneA + 1
Sh.Range("B" & LigneB).Value = tb(1)
Sh.Range("B" & ColonneB).Value = tb(1)
LigneB = LigneB + 1
ColonneB = ColonneB + 1
Sh.Range("C" & LigneC).Value = tb(2)
Sh.Range("C" & ColonneC).Value = tb(2)
LigneC = LigneC + 1
ColonneC = ColonneC + 1
Sh.Range("D" & LigneD).Value = tb(3)
Sh.Range("D" & ColonneD).Value = tb(3)
LigneD = LigneD + 1
ColonneD = ColonneD + 1
Sh.Range("E" & LigneE).Value = tb(4)
Sh.Range("E" & ColonneE).Value = tb(4)
LigneE = LigneE + 1
ColonneE = ColonneE + 1
Sh.Range("F" & LigneF).Value = tb(5)
Sh.Range("F" & ColonneF).Value = tb(5)
LigneF = LigneF + 1
ColonneF = ColonneF + 1
Sh.Range("G" & LigneG).Value = tb(6)
Sh.Range("G" & ColonneG).Value = tb(6)
LigneG = LigneG + 1
ColonneG = ColonneG + 1
End If
Wend
 
Next
 
End If
 
End Sub

Merci beaucoup

Aquuarium33