Importer des csv dans un fichier excel

Version imprimable

Bonsoir,

En tant que grand débutant, je cherchais le code d'une macro qui me permette de réaliser la même action que dans cette discussion :)

Par contre lorsque je la lance, seule la premiere colonne de mon CSV est importé dans mon xls...sauriez-vous comment importer 'l'ensemble des colonnes du CSV (séparé par des ",") tout en conservant la même action qu'actuellement ???

Merci par avance pour votre aide.

En parcourant le forum, je viens de trouver comment contourner... : renommer mes CSV en .txt et :

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
Sub csvImport()
Dim Wbcsv As Workbook
Dim Fichier As String, Chemin As String
Dim LastLig As Long, NewLig As Long
Dim c As Range
Dim Tablo
Const Sep As String = ","
 
Application.ScreenUpdating = False                       'Inhibe la mise à jour affichage
With Application.FileDialog(msoFileDialogFolderPicker)
   .Show
   If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
   Chemin = Chemin & "\"
   Fichier = Dir(Chemin & "*.txt")                       'Le premier fichier csv trouvé
   Do While Fichier <> ""                                'on fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
      Set Wbcsv = Workbooks.Open(Chemin & Fichier)       'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
      With Wbcsv.Sheets(1)
         LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row  'LastLig est la dernière ligne remplie du fichier csv ouvert
      End With
      With ThisWorkbook.Worksheets("Feuil1")
         For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)   'Pour chaque cellule de A2:Axxx
            NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1   'la première cellule vide de la colonne 1 de Feuil1 de ce classeur
            Tablo = Split(c.Value, Sep)                     'On sépare les données par rapport au séparateur (ici le point virgule)
            .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo   'on copie
         Next c
      End With
      Wbcsv.Close                                        'On ferme le fichier csv
      Fichier = Dir()                                    'on cherche le fichir csv suivant
   Loop                                                  'on reboucle
End If
End Sub

Par contre, maintenant je ne sais pas trop comment implémenter une fonction qui me permette de renommer tous les fichier .csv en .txt au préalable...:?

Tu peux essayer ce début de code (tiré de l'enregistreur de macros) à adapter:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Macro2()
Dim Chemin As String, Fichier As String
Dim Sh As Worksheet
 
Application.ScreenUpdating = False
Chemin = "C:\Users\user\Desktop\"                                    'Adapte chemin du fichier
Fichier = "AAAA.csv"                                                 'Adapte nom du fichier
Set Sh = ThisWorkbook.Sheets("Feuil10")                              'Adapte nom de la feuille
With Sh.QueryTables.Add(Connection:="TEXT;" & Chemin & Fichier, _
                        Destination:=Sh.Range("A1"))                 'adapte cellule de destination
    .TextFileCommaDelimiter = True
    .TextFileColumnDataTypes = Array(1, 1, 1, 1)                     'Adapte au nombre de colonnes (ici 4 colonnes avec un type standard)
    .Refresh BackgroundQuery:=False
End With
Sh.QueryTables(1).Delete
Set Sh = Nothing
End Sub

Citation:

Par contre, maintenant je ne sais pas trop comment implémenter une fonction qui me permette de renommer tous les fichier .csv en .txt au préalable

Regarde ceci

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
Sub csvImport()
Dim Wbcsv As Workbook
Dim Fichier As String, Chemin As String
Dim LastLig As Long, NewLig As Long
Dim c As Range
Dim Tablo
Const Sep As String = ","
 
Application.ScreenUpdating = False                                   'Inhibe la mise à jour affichage
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
    Chemin = Chemin & "\"
    Fichier = Dir(Chemin & "*.csv")                                  'Le premier fichier csv trouvé
    Do While Fichier <> ""                                           'on fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
        Name Fichier As Replace(Fichier, ".csv", ".txt")
        Fichier = Replace(Fichier, ".csv", ".txt")
        Set Wbcsv = Workbooks.Open(Chemin & Fichier)                 'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
        With Wbcsv.Sheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row           'LastLig est la dernière ligne remplie du fichier csv ouvert
        End With
        With ThisWorkbook.Worksheets("Feuil6")
            For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)    'Pour chaque cellule de A2:Axxx
                NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1    'la première cellule vide de la colonne 1 de Feuil1 de ce classeur
                Tablo = Split(c.Value, Sep)                          'On sépare les données par rapport au séparateur (ici le point virgule)
                .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo    'on copie
            Next c
        End With
        Wbcsv.Close                                                  'On ferme le fichier csv
        Fichier = Dir()                                              'on cherche le fichir csv suivant
    Loop                                                             'on reboucle
End If
End Sub

19/06/2011, 00h47
LOLYLO

Merci pour ton retour.

J'avais essayer de le faire mais cela ne correspondait pas à ce que je voulais faire :

Choix du répertoire via fenêtre, puis importation de tous les fichiers présents.

La solution de l'enregistreur de macro est trop ciblée (1 répertoire, 1 fichier, 1 cellule destination).

J'ai presque ma solution, il faut juste que j'arrive à présent à implémenter un bout de code (ou nouvelle macro) qui me permette de renommer les extensions de mes fichiers via une fenêtre d'ouverture pour le choix du répertoire...et que cette macro renomme tous les fichiers .csv qu'elle trouve en .txt

J'ai cru comprendre qu'il était possible de procéder en faisant une copie du fichier puis en renommant cette copie...mais mes compétences ne sont pas encore assez développées pour créer cela ...:oops:

EDIT : je teste de suite ta proposition :)

J'obtiens ce résultat pour l'implémentation du renommage :

Erreur 53 (fichier introuvable) sur :

Code:

Name Fichier As Replace(Fichier, ".csv", ".txt")

Essaies plutôt ceci
on cherche les csv dans le répertoire choisi, on renomme les fichiers en .txt, on fait le traitement et on re renomme les fichiers en .csv. L'utilisateur ne remarquera rien.
C'est un peu tordu mais bon

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 csvImport()
Dim Wbcsv As Workbook
Dim Fichier As String, Chemin As String
Dim LastLig As Long, NewLig As Long
Dim c As Range
Dim Tablo
Const Sep As String = ","
 
Application.ScreenUpdating = False                                   'Inhibe la mise à jour affichage
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
    Chemin = Chemin & "\"
    Fichier = Dir(Chemin & "*.csv")                                  'Le premier fichier csv trouvé
    Do While Fichier <> ""                                           'on fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
        Name Fichier As Replace(Fichier, ".csv", ".txt")
        Fichier = Replace(Fichier, ".csv", ".txt")
        Set Wbcsv = Workbooks.Open(Chemin & Fichier)                 'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
        With Wbcsv.Sheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row           'LastLig est la dernière ligne remplie du fichier csv ouvert
        End With
        With ThisWorkbook.Worksheets("Feuil6")
            For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)    'Pour chaque cellule de A2:Axxx
                NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1    'la première cellule vide de la colonne 1 de Feuil1 de ce classeur
                Tablo = Split(c.Value, Sep)                          'On sépare les données par rapport au séparateur (ici le point virgule)
                .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo    'on copie
            Next c
        End With
        Wbcsv.Close                                                  'On ferme le fichier csv
        Name Fichier As Replace(Fichier, ".txt", ".csv")
        Fichier = Dir()                                              'on cherche le fichir csv suivant
    Loop                                                             'on reboucle
End If
End Sub

EDIT

Citation:

J'obtiens ce résultat pour l'implémentation du renommage :

Erreur 53 (fichier introuvable) sur :

Quel code as tu utilisé, j'ai testé

19/06/2011, 01h14
LOLYLO

J'ai essayé les 2 dernières macros fournies et pour les deux j'ai le même message d'erreur...:cry:

...et je précise que mon répertoire contient bien au moins un .CSV
19/06/2011, 01h20
mercatog

Mets TON code que tu as testé. ne me dis pas que c'est le même. Copie-le texto et mets-le ici.

Ok ;)
Premier code testé :

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
Sub csvImport2()
Dim Wbcsv As Workbook
Dim Fichier As String, Chemin As String
Dim LastLig As Long, NewLig As Long
Dim c As Range
Dim Tablo
Const Sep As String = ","
 
Application.ScreenUpdating = False                                   'Inhibe la mise à jour affichage
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
    Chemin = Chemin & "\"
    Fichier = Dir(Chemin & "*.csv")                                  'Le premier fichier csv trouvé
    Do While Fichier <> ""                                           'on fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
        Name Fichier As Replace(Fichier, ".csv", ".txt")
        Fichier = Replace(Fichier, ".csv", ".txt")
        Set Wbcsv = Workbooks.Open(Chemin & Fichier)                 'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
        With Wbcsv.Sheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row           'LastLig est la dernière ligne remplie du fichier csv ouvert
        End With
        With ThisWorkbook.Worksheets("Feuil1")
            For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)    'Pour chaque cellule de A2:Axxx
                NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1    'la première cellule vide de la colonne 1 de Feuil1 de ce classeur
                Tablo = Split(c.Value, Sep)                          'On sépare les données par rapport au séparateur (ici le point virgule)
                .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo    'on copie
            Next c
        End With
        Wbcsv.Close                                                  'On ferme le fichier csv
        Fichier = Dir()                                              'on cherche le fichir csv suivant
    Loop                                                             'on reboucle
End If
End Sub

Second code testé :

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 csvImport3()
Dim Wbcsv As Workbook
Dim Fichier As String, Chemin As String
Dim LastLig As Long, NewLig As Long
Dim c As Range
Dim Tablo
Const Sep As String = ","
 
Application.ScreenUpdating = False                                   'Inhibe la mise à jour affichage
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
    Chemin = Chemin & "\"
    Fichier = Dir(Chemin & "*.csv")                                  'Le premier fichier csv trouvé
    Do While Fichier <> ""                                           'on fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
        Name Fichier As Replace(Fichier, ".csv", ".txt")
        Fichier = Replace(Fichier, ".csv", ".txt")
        Set Wbcsv = Workbooks.Open(Chemin & Fichier)                 'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
        With Wbcsv.Sheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row           'LastLig est la dernière ligne remplie du fichier csv ouvert
        End With
        With ThisWorkbook.Worksheets("Feuil")
            For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)    'Pour chaque cellule de A2:Axxx
                NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1    'la première cellule vide de la colonne 1 de Feuil1 de ce classeur
                Tablo = Split(c.Value, Sep)                          'On sépare les données par rapport au séparateur (ici le point virgule)
                .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo    'on copie
            Next c
        End With
        Wbcsv.Close                                                  'On ferme le fichier csv
        Name Fichier As Replace(Fichier, ".txt", ".csv")
        Fichier = Dir()                                              'on cherche le fichir csv suivant
    Loop                                                             'on reboucle
End If
End Sub

Bon, c'était mon test qui n'était pas le bon, j'avais mis un fichier csv sur le dossier par défaut et

Code:

Name Fichier As Replace(Fichier, ".csv", ".txt")

passait sans problème Alors qu'il fallait indiquer le chemin complet

Adapte ceci

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
Sub csvImport4()
Dim Wbcsv As Workbook
Dim Fichier As String, Chemin As String
Dim LastLig As Long, NewLig As Long
Dim c As Range
Dim Tablo
Const Sep As String = ","
 
Application.ScreenUpdating = False                                   'Inhibe la mise à jour affichage
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
    Chemin = Chemin & "\"
    Fichier = Dir(Chemin & "*.csv")                                  'Le premier fichier csv trouvé
    Do While Fichier <> ""                                           'on fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
        Name Chemin & Fichier As Replace(Chemin & Fichier, ".csv", ".txt")
        Fichier = Replace(Fichier, ".csv", ".txt")
        Set Wbcsv = Workbooks.Open(Chemin & Fichier)                 'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
        With Wbcsv.Sheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row           'LastLig est la dernière ligne remplie du fichier csv ouvert
        End With
        With ThisWorkbook.Worksheets("Feuil6")
            For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)    'Pour chaque cellule de A2:Axxx
                NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1    'la première cellule vide de la colonne 1 de Feuil1 de ce classeur
                Tablo = Split(c.Value, Sep)                          'On sépare les données par rapport au séparateur (ici le point virgule)
                .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo    'on copie
            Next c
        End With
        Wbcsv.Close                                                  'On ferme le fichier csv
        Set Wbcsv = Nothing
        Name Chemin & Fichier As Replace(Chemin & Fichier, ".txt", ".csv")
        Fichier = Dir()                                              'on cherche le fichir csv suivant
    Loop                                                             'on reboucle
End If
End Sub

Ça marche du tonnerre; Tu es un génie !!!! merci pour tout ! :D

Par contre puis-je te demander une dernière chose ? : une dernière optimisation dans les deux codes que je vais utiliser dans mes fichiers :

Faire en sorte qu'une fois le traitement principal terminé, que la macro déplace le (ou les) fichiers du répertoire choisi initialement vers un répertoire d'archives prédéfini, pour les tests on utilisera : C:\Users\R1\Desktop\CSV\archives\

Et ce pour la macro1 "TXT" (oui finalement j'ai aussi des import txt en natif) :

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
Sub csvImport()
Dim Wbcsv As Workbook
Dim Fichier As String, Chemin As String
Dim LastLig As Long, NewLig As Long
Dim c As Range
Dim Tablo
Const Sep As String = ","
 
Application.ScreenUpdating = False                       'Inhibe la mise à jour affichage
With Application.FileDialog(msoFileDialogFolderPicker)
   .Show
   If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
   Chemin = Chemin & "\"
   Fichier = Dir(Chemin & "*.txt")                       'Le premier fichier csv trouvé
   Do While Fichier <> ""                                'on fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
      Set Wbcsv = Workbooks.Open(Chemin & Fichier)       'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
      With Wbcsv.Sheets(1)
         LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row  'LastLig est la dernière ligne remplie du fichier csv ouvert
      End With
      With ThisWorkbook.Worksheets("Feuil1")
         For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)   'Pour chaque cellule de A2:Axxx
            NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1   'la première cellule vide de la colonne 1 de Feuil1 de ce classeur
            Tablo = Split(c.Value, Sep)                     'On sépare les données par rapport au séparateur (ici le point virgule)
            .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo   'on copie
         Next c
      End With
      Wbcsv.Close                                        'On ferme le fichier csv
      Fichier = Dir()                                    'on cherche le fichir csv suivant
   Loop                                                  'on reboucle
End If
End Sub

et pour la macro "CSV":

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
Sub csvImport4()
Dim Wbcsv As Workbook
Dim Fichier As String, Chemin As String
Dim LastLig As Long, NewLig As Long
Dim c As Range
Dim Tablo
Const Sep As String = ","
 
Application.ScreenUpdating = False                                   'Inhibe la mise à jour affichage
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
    Chemin = Chemin & "\"
    Fichier = Dir(Chemin & "*.csv")                                  'Le premier fichier csv trouvé
    Do While Fichier <> ""                                           'on fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
        Name Chemin & Fichier As Replace(Chemin & Fichier, ".csv", ".txt")
        Fichier = Replace(Fichier, ".csv", ".txt")
        Set Wbcsv = Workbooks.Open(Chemin & Fichier)                 'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
        With Wbcsv.Sheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row           'LastLig est la dernière ligne remplie du fichier csv ouvert
        End With
        With ThisWorkbook.Worksheets("Feuil1")
            For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)    'Pour chaque cellule de A2:Axxx
                NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1    'la première cellule vide de la colonne 1 de Feuil1 de ce classeur
                Tablo = Split(c.Value, Sep)                          'On sépare les données par rapport au séparateur (ici le point virgule)
                .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo    'on copie
            Next c
        End With
        Wbcsv.Close                                                  'On ferme le fichier csv
        Set Wbcsv = Nothing
        Name Chemin & Fichier As Replace(Chemin & Fichier, ".txt", ".csv")
        Fichier = Dir()                                              'on cherche le fichir csv suivant
    Loop                                                             'on reboucle
End If
End Sub

Merci par avance si tu peux rajouter cela ;) et ensuite je passerai quelques heures à tout décrypter dans le détail pour bien tout comprendre !!! 8O

Bonjour
Pour l'ultime question, tu pouvais arriver tout seul. En effet, il suffit de changer le répertoire du 2ème renommage:

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
Sub csvImport5()
Dim Fichier As String, Chemin As String, RepArchive As String
Dim LastLig As Long, NewLig As Long
Dim Wbcsv As Workbook
Dim c As Range
Dim Tablo
 
Application.ScreenUpdating = False                                                                 'Inhibe le rafraichissement affichage
With Application.FileDialog(msoFileDialogFolderPicker)                                             'Ouvre la boite de dialogue pour sélection de dosiier
    .Show
    If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
    RepArchive = "C:\Users\user\Desktop\CSV\Archives\"
    Chemin = Chemin & "\"
    Fichier = Dir(Chemin & "*.csv")                                                                'Le premier fichier csv trouvé
    Do While Fichier <> ""                                                                         'On fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
        Name Chemin & Fichier As Replace(Chemin & Fichier, ".csv", ".txt")                         'On renomme le csv en txt
        Fichier = Replace(Fichier, ".csv", ".txt")                                                 'On remplace l'extension dans notre variable
        Set Wbcsv = Workbooks.Open(Chemin & Fichier)                                               'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
        With Wbcsv.Sheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row                                         'LastLig est la dernière ligne remplie du fichier csv ouvert
        End With
        With ThisWorkbook.Worksheets("Feuil1")
            For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)                                  'Pour chaque cellule de A2:Axxx
                NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1                                  'La première cellule vide de la colonne 1 de Feuil1 de ce classeur
                Tablo = Split(c.Value, ",")                                                        'On sépare les données par rapport au séparateur (ICI LA VIRGULE)
                .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo         'On copie
            Next c
        End With
        Wbcsv.Close                                                                                'On ferme le fichier csv
        Set Wbcsv = Nothing                                                                        'On libère la variable
        Name Chemin & Fichier As Replace(RepArchive & Fichier, ".txt", ".csv")                     'On re modifie l'extension et le répertoire de notre fichier
        Fichier = Dir()                                                                            'On cherche le fichir csv suivant
    Loop                                                                                           'On reboucle
End If
End Sub

Une nouvelle erreur 53 :

Sur :

Code:

Name Chemin & Fichier As Replace(RepArchive & Fichier, ".txt", ".csv")                     'On re modifie l'extension et le répertoire de notre fichier

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
 
Sub csvImport5()
Dim Fichier As String, Chemin As String, RepArchive As String
Dim LastLig As Long, NewLig As Long
Dim Wbcsv As Workbook
Dim c As Range
Dim Tablo
 
Application.ScreenUpdating = False                                                                 'Inhibe le rafraichissement affichage
With Application.FileDialog(msoFileDialogFolderPicker)                                             'Ouvre la boite de dialogue pour sélection de dosiier
    .Show
    If .SelectedItems.Count = 1 Then Chemin = .SelectedItems(1)
End With
 
If Chemin <> "" Then
    RepArchive = "C:\Users\user\Desktop\CSV\Archives\"
    Chemin = Chemin & "\"
    Fichier = Dir(Chemin & "*.csv")                                                                'Le premier fichier csv trouvé
    Do While Fichier <> ""                                                                         'On fait une boucle jusqu'à ce qu'on ne trouve plus de fichier csv
        Name Chemin & Fichier As Replace(Chemin & Fichier, ".csv", ".txt")                         'On renomme le csv en txt
        Fichier = Replace(Fichier, ".csv", ".txt")                                                 'On remplace l'extension dans notre variable
        Set Wbcsv = Workbooks.Open(Chemin & Fichier)                                               'On ouvre le fichier csv qu'on affecte à la variable Wbcsv
        With Wbcsv.Sheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row                                         'LastLig est la dernière ligne remplie du fichier csv ouvert
        End With
        With ThisWorkbook.Worksheets("Feuil1")
            For Each c In Wbcsv.Sheets(1).Range("A2:A" & LastLig)                                  'Pour chaque cellule de A2:Axxx
                NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1                                  'La première cellule vide de la colonne 1 de Feuil1 de ce classeur
                Tablo = Split(c.Value, ",")                                                        'On sépare les données par rapport au séparateur (ICI LA VIRGULE)
                .Range(.Cells(NewLig, 1), .Cells(NewLig, UBound(Tablo) + 1)).Value = Tablo         'On copie
            Next c
        End With
        Wbcsv.Close                                                                                'On ferme le fichier csv
        Set Wbcsv = Nothing                                                                        'On libère la variable
        Name Chemin & Fichier As Replace(RepArchive & Fichier, ".txt", ".csv")                     'On re modifie l'extension et le répertoire de notre fichier
        Fichier = Dir()                                                                            'On cherche le fichir csv suivant
    Loop                                                                                           'On reboucle
End If
End Sub

19/06/2011, 12h58
mercatog

As tu adapté ceci

Code:

RepArchive = "C:\Users\user\Desktop\CSV\Archives\"
19/06/2011, 15h46
LOLYLO

Oups en effet je suis allé trop vite ! :oops:

Ça fonctionne à la perfection, c'est super ! Merci pour tout.

J'ai aussi adapté le nécessaire pour ma macro .txt et ça fonctionne très bien.