Macro VBA séparer gros fichier CSV sur plusieurs feuilles

Bonjour à tous,

Cela fait désormais 10 jours que j'essaie mais ne trouve pas de code pour séparer un fichier CSV via une macro.

Je m'explique : j'ai extrait un fichier au format .CSV qui compte plus de 10 millions de lignes (nb lignes pouvant changer). J'aimerais obtenir une macro VBA qui sépare le gros fichier initial sur plusieurs feuilles d'un même classeur toutes les 1 millions de lignes.

Pouvez-vous m'aider SVP ?

Cordialement,
Easy58230

Bonjour Easy58230 le forum

si ton fichier ne comporte pas de données personnelles, passe le en fichier joint en .zip et tu passes le lien, je suis curieux de traiter cela

a+

Papou

Salut Paritec !

Malheureusement c'est des données confidentielles que je ne peux partager... En espérant que tu pourras tout de même m'aider

A+
Easy58230

Bonjour et bienvenue,

Quelle est la version d'Excel utilisée ?

Cdlt.

Bonjour Jean-Eric,

J'utilise Microsoft Office Professional Plus 2010.

En espérant que vous puissiez m'aider,

Bonne journée,

Easy58230

Bonjour,

Si tu as la possibilité : télécharge et installe Power Query pour Excel 2010-2013.

C'est un complément gratuit Microsoft.

Essaie ensuite de charger ton csv !...

Lien utile : https://www.youtube.com/watch?v=xcJssdy0M3A

Bonjour à tous,

une version plus classique

Sub ImporterEnGros()
Dim donnees As Variant
    donnees = Application.GetOpenFilename("Text Files (*.csv), *.csv")
    If donnees = False Then Exit Sub
    Extraction donnees, [_sep], [_lignes]
End Sub

Sub Extraction(Fichier As Variant, Separateur As Variant, taille As Long)
    Dim Tableau() As String
    Dim f As Worksheet
    Dim Resultat
    Open Fichier For Input As #1
        ligne = 1
        Do While Not EOF(1)
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne, Separateur)
            nItems = UBound(Tableau) + 1
            If ligne = 1 Then ReDim Resultat(1 To nItems, 1 To 1)
            If ligne > 1 Then ReDim Preserve Resultat(1 To nItems, 1 To ligne) ' Preserve ne permet de redimensionner que la dernière dimension d'un tableau avec conservation des données
            For i = 0 To UBound(Tableau)
                Resultat(i + 1, ligne) = Tableau(i)
            Next i
            ligne = ligne + 1
            If ligne > taille Then
                Set f = Sheets.Add(After:=Worksheets(Worksheets.Count))
                Resultat = Application.Transpose(Resultat)
                f.Cells(1, 1).Resize(UBound(Resultat), UBound(Resultat, 2)) = Resultat
                ligne = 1
            End If
        Loop
    Close #1
    If ligne > 1 Then
        Set f = Sheets.Add(After:=Worksheets(Worksheets.Count))
        Resultat = Application.Transpose(Resultat)
        MsgBox UBound(Resultat)
        If ligne > 2 Then
            f.Cells(1, 1).Resize(UBound(Resultat), UBound(Resultat, 2)) = Resultat
        Else
            f.Cells(1, 1).Resize(1, nItems) = Resultat
        End If
    End If
End Sub

Si tu as des dates ou des nombres, on peut le traiter en même temps ...

Essaie néanmoins la version PowerQuery proposée par Jean-Eric