[XL-2003] Ouverture d'un fichier CSV

[ARTETA13]

Bonjour,

Je débute en VBA et je souhaite ouvrir à l'aide de VBA un fichier CSV copier ces données et enregistrer ces données sur un fichier excel.
Pourriez-vous m'aider sur le code.

Un grand merci!!!

[kiki29]

Salut, tu peux utiliser l'enregistreur de macros puis optimiser le code manuellement, à moins que tu ne veuilles traiter à la volée le fichier CSV ?

Une autre approche, affecter un bouton à SelFichier

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
Option Explicit
 
Sub SelFichier()
Dim sChemin As String
Dim sFichier As String, sExt As String
Dim Pos As Long
 
    sChemin = ThisWorkbook.Path
 
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = sChemin & "\"
        .Title = "Sélectionner le fichier CSV"
        .AllowMultiSelect = False
        .ButtonName = "Sélection Fichier"
 
        .Filters.Clear
        .Filters.Add "Texte", "*.csv"
 
        .Show
        If .SelectedItems.Count > 0 Then
            DoEvents
            Application.ScreenUpdating = False
            Feuil1.Cells.Clear
 
            LectureCSV .SelectedItems(1)
 
            Pos = InStrRev(.SelectedItems(1), "\")
            sFichier = Mid$(.SelectedItems(1), Pos + 1)
            Pos = InStrRev(sFichier, ".")
            sFichier = Left$(sFichier, Pos - 1)
 
            Sauvegarde sFichier
 
            With Feuil1
                .Activate
                .Range("A1").Select
            End With
            Application.ScreenUpdating = True
        End If
    End With
End Sub
 
Private Sub LectureCSV(sFichier As String)
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim sChaine As String, i As Long
Dim Separateur As String, Ar() As String
 
    NumFichier = FreeFile
    Separateur = ";"
 
    iRow = 1
    Open sFichier For Input As NumFichier
    Do While Not EOF(NumFichier)
        iCol = 1
        Line Input #NumFichier, sChaine
        Ar = Split(sChaine, Separateur)
        For i = LBound(Ar) To UBound(Ar)
            Feuil1.Cells(iRow, iCol) = Ar(i)
            iCol = iCol + 1
        Next i
        iRow = iRow + 1
    Loop
    Close NumFichier
End Sub
 
Private Sub Sauvegarde(sNomFichier As String)
Dim sNom As String, Wkb As Workbook
    sNom = ThisWorkbook.Path & "\" & sNomFichier & ".xls"
    Application.DisplayAlerts = False
 
    Feuil1.UsedRange.Copy
    Set Wkb = Workbooks.Add
 
    With Wkb
        With .ActiveSheet
            .Paste
            .Range("A1").Select
        End With
        .SaveAs Filename:=sNom, FileFormat:=xlNormal
        .Close
    End With
 
    Application.DisplayAlerts = True
End Sub

A lire http://excel.developpez.com/faq/?page=ChapFichiersTxt