XL 2019 Importer fichier csv sans consatener les colonnes

carlos

XLDnaute Impliqué
Supporter XLD
Bonjour,
Cette macro ci dessous, me permet d'importer le contenu de plusieurs fichiers ".csv".
Ces fichiers ont plusieurs colonne et lignes avec des valeurs bien séparées.
Ce quie je ne comprends pas c'est qu'il me concatène toutes les colonnes entre elles.
Est il possible de faire une copie des cellule sans cioncatenage?
Merci et bonne soirée

VB:
Sub Bouton2_Cliquer()

Dim wbDest As Workbook, wbSource As Workbook
Dim wsDest As Worksheet, wsSource As Worksheet
Dim myFile As String, myPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wbDest = ThisWorkbook
    Set wsDest = wbDest.Worksheets(1)
    myPath = "D:\Dossier Dest\"
    myFile = Dir(myPath & "*.csv")

    Do While myFile <> ""
        Set wbSource = Workbooks.Open(myPath & myFile)
        Set wsSource = wbSource.Worksheets(Split(myFile, ".")(0))
            wsSource.Unprotect
            wsSource.Cells(1).CurrentRegion.Copy

        wsSource.Range(Cells(1, 1), Cells(24, 24)).Copy
        With wbDest
            .Worksheets.Add After:=Worksheets(Worksheets.Count)
           If IsError(Evaluate("=" & wsSource.Name & "!A1")) Then
                ' si la feuille n'existe pas
               .ActiveSheet.Name = wsSource.Name
            Else
                .ActiveSheet.Name = wsSource.Name
            End If
            .Activate
            .ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
        End With
        wbSource.Close
        myFile = Dir

    Loop

    Set wsDest = Nothing: Set wsSource = Nothing
    Set wbDest = Nothing: Set wbSource = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Dernière modification par un modérateur:
Solution
Voici une 3ème méthode, très rapide aussi, par requête QueryTables :
VB:
Private Sub CommandButton3_Click()
Dim t, wbDest As Workbook, myPath$, myFile$, cn As Object, mySheetName$
t = Timer
Set wbDest = ThisWorkbook
'myPath = "D:\Lycée Stéphane Hessel\OneDrive - Lycée Stéphane Hessel\Karl EPS\Protocoles BGT BCP CAP 23\Import Fichiers Santorin\"
myPath = wbDest.Path & "\"
myFile = Dir(myPath & "*.csv")
Application.ScreenUpdating = False
For Each cn In wbDest.Connections: cn.Delete: Next 'supprime les connexions existantes
Do While myFile <> ""
    mySheetName = Left(myFile, Len(myFile) - 4)
    With wbDest
        .Activate
        On Error Resume Next
        .Sheets(mySheetName).Activate
        On Error GoTo 0
        If...

carlos

XLDnaute Impliqué
Supporter XLD
Bonjour JOB75,
Cest génial. Et en plus très pédagogoue car tes 3 propositions fonctionnent tres bien avec tes fichiers CSV.
Avec mes fichiers, seule la proposition Power Query fonctionne parfaitement. Ce qui me suffit amplement .
Pour info :
Ouverture classique des fichiers CSV, importe bien toutes les feuilles mais concatene en colonne 1
En séquentielle : ca bloque apres l'import de la seconde feuille sur "With ActiveSheet.Cells(1).Resize(UBound(s))". Les donnéees sont concaténées aussi.

En résumé je suis extrement content car je vais pouvoir traiter mes 144 fichiers grace à ton code, PowerQuery.
Excellente Journée et encore merci pour tout le travail que tu fais mais aussi que chacun de vous faites sur cet excellent site.

Carlos
 

job75

XLDnaute Barbatruc
Cela dit ma dernière macro n'est pas totalement satisfaisante.

Cliquez plusieurs fois sur le bouton et ouvrez le Gestionnaire de noms.

Vous verrez que les noms "DonnéesExternes" s'accumulent malgré la suppression des connexions.

Il vaut donc mieux supprimer les feuilles créées précédemment :
VB:
Private Sub CommandButton3_Click()
Dim t, wbDest As Workbook, myPath$, w As Worksheet, myFile$, mySheetName$
t = Timer
Set wbDest = ThisWorkbook
'myPath = "D:\Lycée Stéphane Hessel\OneDrive - Lycée Stéphane Hessel\Karl EPS\Protocoles BGT BCP CAP 23\Import Fichiers Santorin\"
myPath = wbDest.Path & "\"
myFile = Dir(myPath & "*.csv")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---suppression des feuilles créées précédemment---
For Each w In wbDest.Worksheets
    If w.QueryTables.Count Then w.Delete
Next w
'---création des feuilles---
Do While myFile <> ""
    mySheetName = Left(myFile, Len(myFile) - 4)
    With wbDest
        .Activate
        On Error Resume Next
        .Sheets(mySheetName).Delete 'au cas où...
        On Error GoTo 0
        .Sheets.Add After:=.Sheets(.Sheets.Count)
        ActiveSheet.Name = mySheetName
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile, Destination:=ActiveSheet.Cells(1))
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True
            .Refresh
        End With
    End With
    myFile = Dir
Loop
wbDest.Sheets(1).Activate
MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
End Sub
 

Pièces jointes

  • Dossier.zip
    489.5 KB · Affichages: 3
Dernière édition:

cathodique

XLDnaute Barbatruc
Cela dit ma dernière macro n'est pas totalement satisfaisante.

Cliquez plusieurs fois sur le bouton et ouvrez le Gestionnaire de noms.

Vous verrez que les noms "DonnéesExternes" s'accumulent malgré la suppression des connexions.

Il vaut donc mieux supprimer les feuilles créées précédemment :
VB:
Private Sub CommandButton3_Click()
Dim t, wbDest As Workbook, myPath$, w As Worksheet, myFile$, mySheetName$
t = Timer
Set wbDest = ThisWorkbook
'myPath = "D:\Lycée Stéphane Hessel\OneDrive - Lycée Stéphane Hessel\Karl EPS\Protocoles BGT BCP CAP 23\Import Fichiers Santorin\"
myPath = wbDest.Path & "\"
myFile = Dir(myPath & "*.csv")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---suppression des feuilles créées précédemment---
For Each w In wbDest.Worksheets
    If w.QueryTables.Count Then w.Delete
Next w
'---création des feuilles---
Do While myFile <> ""
    mySheetName = Left(myFile, Len(myFile) - 4)
    With wbDest
        .Activate
        On Error Resume Next
        .Sheets(mySheetName).Delete 'au cas où...
        On Error GoTo 0
        .Sheets.Add After:=.Sheets(.Sheets.Count)
        ActiveSheet.Name = mySheetName
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile, Destination:=ActiveSheet.Cells(1))
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True
            .Refresh
        End With
    End With
    myFile = Dir
Loop
wbDest.Sheets(1).Activate
MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
End Sub
Bonsoir tout le monde;),

J'ai hésité mais... je mets mon grain de sel.

@job75 ;):cool::cool::cool:, ton code est super. En effet, dans le Gestionnaire de noms, les noms "DonnéesExternes" ne s'accumulent plus. ça serait parfait si les noms ne s'ajoutaient pas ou qu'ils soient supprimés. ou bien est-ce impossible lorsqu'on utilise QueryTables (que je connais pas).

Merci.

Bonne soirée.
 

laurent950

XLDnaute Barbatruc
Bonjour,

Voici une variante : a tester
chemin a adapter pour votre fichier :
filePath = "C:\chemin\vers\le\fichier.csv"

VB:
Sub ImportCSVWithDynamicColumns()
    Dim ws As Worksheet
    Dim filePath As String
    Dim qt As QueryTable
    Dim firstLine As String
    Dim colCount As Integer
    Dim colDataTypes() As Integer
    Dim i As Integer
    Dim FSO As Object
    Dim myFile As Object

    ' Définir le chemin du fichier CSV
    filePath = "C:\chemin\vers\le\fichier.csv"
 
    ' Vérifier si le fichier existe
    If Dir(filePath) = "" Then
        MsgBox "Le fichier n'existe pas : " & filePath, vbExclamation
        Exit Sub
    End If
 
    ' Lire la première ligne du fichier CSV
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFile = FSO.OpenTextFile(filePath, 1)
    If Not myFile.AtEndOfStream Then
        firstLine = myFile.ReadLine
    End If
    myFile.Close
 
    ' Afficher la première ligne pour vérification
    MsgBox "Première ligne du fichier CSV: " & firstLine
 
    ' Compter le nombre de colonnes en comptant les délimiteurs ;
    colCount = UBound(Split(firstLine, ";")) + 1
 
    ' Créer dynamiquement le tableau TextFileColumnDataTypes
    ReDim colDataTypes(1 To colCount)
    For i = 1 To colCount
        colDataTypes(i) = 1 ' Importer toutes les colonnes comme texte
    Next i
 
    ' Ajouter une nouvelle feuille ou utiliser la feuille active
    Set ws = ThisWorkbook.Sheets.Add ' Vous pouvez aussi utiliser ThisWorkbook.Sheets("NomDeLaFeuille")
 
    ' Créer une QueryTable pour importer les données du fichier CSV
    On Error GoTo ErrHandler
    Set qt = ws.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=ws.Range("A1"))
 
    ' Configurer les paramètres de la QueryTable
    With qt
        .TextFileParseType = xlDelimited
        '.TextFileCommaDelimiter = False
        .TextFileSemicolonDelimiter = True ' Définir le délimiteur comme un point-virgule
        '.TextFileConsecutiveDelimiter = False
        '.TextFileTabDelimiter = False
        '.TextFileSpaceDelimiter = False
        '.TextFileOtherDelimiter = False
        .TextFileColumnDataTypes = colDataTypes ' Utiliser le tableau dynamique
        .Refresh BackgroundQuery:=False
        .Parent.Names(.Name).Delete       ' Supprimer le nom défini créé par Excel
        .Delete ' Supprimer la QueryTable   
    End With

    ' Nettoyer
    Set qt = Nothing
    Set ws = Nothing
    Exit Sub

ErrHandler:
    MsgBox "Erreur lors de l'importation du fichier CSV : " & Err.Description, vbCritical
    If Not qt Is Nothing Then
        qt.Delete
        Set qt = Nothing
    End If
    If Not ws Is Nothing Then
        ws.Delete
        Set ws = Nothing
    End If
End Sub
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonsoir cathodique, laurent950,
En effet, dans le Gestionnaire de noms, les noms "DonnéesExternes" ne s'accumulent plus. ça serait parfait si les noms ne s'ajoutaient pas ou qu'ils soient supprimés. ou bien est-ce impossible lorsqu'on utilise QueryTables (que je connais pas).
Oui cette macro supprime le nom défini dans la feuille et la requête dès la QueryTable créée :
VB:
Private Sub CommandButton3_Click()
Dim t, wbDest As Workbook, myPath$, myFile$, mySheetName
t = Timer
Set wbDest = ThisWorkbook
'myPath = "D:\Lycée Stéphane Hessel\OneDrive - Lycée Stéphane Hessel\Karl EPS\Protocoles BGT BCP CAP 23\Import Fichiers Santorin\"
myPath = wbDest.Path & "\"
myFile = Dir(myPath & "*.csv")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While myFile <> ""
    mySheetName = Left(myFile, Len(myFile) - 4)
    With wbDest
        .Activate
        On Error Resume Next
        .Sheets(mySheetName).Delete 'supprime la feuille si elle existe
        On Error GoTo 0
        .Sheets.Add After:=.Sheets(.Sheets.Count)
        ActiveSheet.Name = mySheetName
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile, Destination:=ActiveSheet.Cells(1))
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True
            .Refresh
            .Parent.Names(.Name).Delete 'supprime le nom défini dans la feuille
            .Delete 'supprime la requête
        End With
    End With
    myFile = Dir
Loop
wbDest.Sheets(1).Activate
MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
End Sub
 

Pièces jointes

  • Dossier.zip
    489.8 KB · Affichages: 6

cathodique

XLDnaute Barbatruc
Bonsoir cathodique, laurent950,

Oui cette macro supprime le nom défini dans la feuille et la requête dès la QueryTable créée :
VB:
Private Sub CommandButton3_Click()
Dim t, wbDest As Workbook, myPath$, myFile$, mySheetName
t = Timer
Set wbDest = ThisWorkbook
'myPath = "D:\Lycée Stéphane Hessel\OneDrive - Lycée Stéphane Hessel\Karl EPS\Protocoles BGT BCP CAP 23\Import Fichiers Santorin\"
myPath = wbDest.Path & "\"
myFile = Dir(myPath & "*.csv")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While myFile <> ""
    mySheetName = Left(myFile, Len(myFile) - 4)
    With wbDest
        .Activate
        On Error Resume Next
        .Sheets(mySheetName).Delete 'supprime la feuille si elle existe
        On Error GoTo 0
        .Sheets.Add After:=.Sheets(.Sheets.Count)
        ActiveSheet.Name = mySheetName
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile, Destination:=ActiveSheet.Cells(1))
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True
            .Refresh
            .Parent.Names(.Name).Delete 'supprime le nom défini dans la feuille
            .Delete 'supprime la requête
        End With
    End With
    myFile = Dir
Loop
wbDest.Sheets(1).Activate
MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
End Sub
Bonjour @job75 ;), @laurent950 ;), @carlos ;), Le forum:),

@job75 : Merci beaucoup, c'est parfait pour moi. Je n'ai pas beaucoup de csv donc c'est d'autant plus rapide.
En sus de la rapidité, ce qui m'a encore plu est la fidélité des formats des données et l'adaptation des largeurs de colonne. J'ouvrirais une discussion pour un petit plus si je ne parviens pas à adapter à mon besoin.

@fanch55 : j'ai testé ton code pour mes csv. Hélas, le résultat n'était pas au RDV. C'est peut-être dû au format des cellules. Une colonne contient des adresses mail.

Encore merci.

Excellente journée.
 

laurent950

XLDnaute Barbatruc
Bonjour @job75 , @cathodique , Le forum

j'ai corrigé le code en Poste #24

A tester avec cela :
0002;2;FLO;"PLACE GENERAL LE FLO";LESNEVEN
0002;4;FLO;"PLACE GENERAL LE FLO";LESNEVEN
0002;6;FLO;"PLACE GENERAL LE FLO";LESNEVEN
0002;10;FLO;"PLACE GENERAL LE FLO";LESNEVEN
0002;12;FLO;"PLACE GENERAL LE FLO";LESNEVEN
0002;16;FLO;"PLACE GENERAL LE FLO";LESNEVEN

Le fichier csv complet ce trouve ici sur cette discussion en Poste #62 pour faire des tests

Code:
Le Bloc A (With qt) --->>> Avant (6 Colonnes dont une Vide "Colonne B")
Définit explicitement d'autres délimiteurs comme False (.TextFileCommaDelimiter, .TextFileTabDelimiter, etc.).
    With qt
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = False
        .TextFileSemicolonDelimiter = True ' Définir le délimiteur comme un point-virgule
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = False
        .TextFileColumnDataTypes = colDataTypes ' Utiliser le tableau dynamique
        .Refresh BackgroundQuery:=False
        .Parent.Names(.Name).Delete       ' Supprimer le nom défini créé par Excel
        .Delete ' Supprimer la QueryTable
    End With

Code:
Le Bloc B (With qt) --->>>  Aprés : (5 Colonnes = OK)
Ne spécifie pas ces autres délimiteurs, donc ils restent à leurs valeurs par défaut.
    With qt
        .TextFileParseType = xlDelimited
        '.TextFileCommaDelimiter = False
        .TextFileSemicolonDelimiter = True ' Définir le délimiteur comme un point-virgule
        '.TextFileConsecutiveDelimiter = False
        '.TextFileTabDelimiter = False
        '.TextFileSpaceDelimiter = False
        '.TextFileOtherDelimiter = False
        .TextFileColumnDataTypes = colDataTypes ' Utiliser le tableau dynamique
        .Refresh BackgroundQuery:=False
        .Parent.Names(.Name).Delete       ' Supprimer le nom défini créé par Excel
        .Delete ' Supprimer la QueryTable
    End With

- Utilise ws comme une variable représentant une feuille de calcul spécifique (ws est probablement définie ailleurs dans le code). La destination est la cellule A1 de cette feuille.
- Crée une QueryTable qt et la configure, mais ne la supprime pas après l'opération.
***********************
A ) Code : Avant :
- Définit explicitement d'autres délimiteurs comme False (.TextFileCommaDelimiter, .TextFileTabDelimiter, etc.).
B) Code : Aprés
- Ne spécifie pas les types de données des colonnes, donc les types par défaut sont utilisés.
***********************
- Actualise la QueryTable en arrière-plan avec BackgroundQuery:=False.
Ajout en complément ci-dessous :
  • .Parent.Names(.Name).Delete : Cette ligne supprime le nom défini associé à la QueryTable. .Parent fait référence à la feuille de calcul (ws dans ce cas) qui contient la QueryTable.
  • .Delete : Cette ligne supprime la QueryTable elle-même, la retirant de la feuille de calcul et libérant les ressources associées.
 
Dernière édition:

Cousinhub

XLDnaute Barbatruc
Inactif
Bonsoir,
@ laurent
Je ne comprends pas que tu utilises un fichier "autre", alors que j'ai demandé à carlos d'en fournir un, avec la même procédure....
Pour le moment, (et en l'absence de précisions), il subsisterait un léger souci
.......le feuilles sont bien importées sauf la première feuille qui est concatenée en A1 et A2. Mince!
Bizarre.
Donc, utiliser un fichier autre, est-ce profitable, ne sachant si la structure est identique?
 

Discussions similaires

Réponses
9
Affichages
281

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh