XL 2016 Création fichier CSV

ZZ59264

XLDnaute Occasionnel
Bonjour au forum,

Je joins un fichier à ma demande de création d'un fichier CSV à partir d'un tableau,

Merci d'avance pour votre aide,

Cordialement,
 

Pièces jointes

  • Classeur1.xlsx
    11.1 KB · Affichages: 18
Solution
Cette macro est la plus rapide :
VB:
Sub ExportCSV()
    Dim t, chemin$, NomFichier$
    t = Timer
    'chemin = "P:\AP\5 B\5 CSV IMPORT\" ' Ne pas oublier "\" à la fin
    chemin = ThisWorkbook.Path & "\"
    NomFichier = "Export_" & Sheets("EN TETE").[AK2] & Format(Date, "_yyyy_mm_dd")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheets("CSV").ListObjects(1).DataBodyRange
        Workbooks.Add 'nouveau document
        [A1].Resize(.Rows.Count, .Columns.Count) = .Value 'copie les valeurs
    End With
    With ActiveWorkbook
        .SaveAs Filename:=chemin & NomFichier, FileFormat:=xlCSV, local:=True
        .Close savechanges:=False
    End With
    MsgBox Timer - t
End Sub
Toujours sur 900 000...

patricktoulon

XLDnaute Barbatruc
si le dossier existe alors il ne devrait pas y avoir de probleme
colonne vide corrigée
VB:
Sub test_patricktoulon()
    Dim dossier$, X&, chemin$, fichier$, texte$
    dossier = "P:\AP\5 B\5 CSV IMPORT\"
    fichier = Sheets("EN TETE").[AK2] & Format(Date, "_yyyy-mm-dd") & ".csv"
    chemin = dossier & fichier
    Range("CSV").Copy           ' on copie le tableau structuré sans les entetes
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .GetFromClipboard: texte = .GetText(1)
        texte = Replace(Replace(texte, vbTab, ";"), "  ", ";"): End With
    X = FreeFile: Open chemin For Output As #X: Print #X, texte: Close #X
    Application.CutCopyMode = False
End Sub
 

ZZ59264

XLDnaute Occasionnel
si le dossier existe alors il ne devrait pas y avoir de probleme
colonne vide corrigée
VB:
Sub test_patricktoulon()
    Dim dossier$, X&, chemin$, fichier$, texte$
    dossier = "P:\AP\5 B\5 CSV IMPORT\"
    fichier = Sheets("EN TETE").[AK2] & Format(Date, "_yyyy-mm-dd") & ".csv"
    chemin = dossier & fichier
    Range("CSV").Copy           ' on copie le tableau structuré sans les entetes
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .GetFromClipboard: texte = .GetText(1)
        texte = Replace(Replace(texte, vbTab, ";"), "  ", ";"): End With
    X = FreeFile: Open chemin For Output As #X: Print #X, texte: Close #X
    Application.CutCopyMode = False
End Sub
Bonsoir,

Merci pour ce code, mais il ne mets pas la colonne vide...

Désolé de vous embêter encore avec ça !

Cordialement,
 

patricktoulon

XLDnaute Barbatruc
re
la colonne y est bien dans le texte obtenu
1639946448311.png
 

ZZ59264

XLDnaute Occasionnel
re
la colonne y est bien dans le texte obtenu
Regarde la pièce jointe 1125168
Ok je crois comprendre,

Dans mon fichier de travail, la colonne ne se nomme pas Z mais "VIDE" !

Et en changeant le nom de celle ci par Z cela fonctionne,

Je vais donc changer mon nom de colonne au lieu de mettre vide je vais la nommer autrement,

Merci pour tout !!!!!

Cordialement,
 

job75

XLDnaute Barbatruc
Bonsoir à tous,

Pour tester j'ai recopié le tableau A2:J7 sur 900 000 lignes.

Voici la macro de sylvanu modifiée pour supprimer la ligne des en-têtes :
VB:
Sub ExportCSV()
    Dim t, chemin$, NomFichier$
    t = Timer
    'chemin = "P:\AP\5 B\5 CSV IMPORT\" ' Ne pas oublier "\" à la fin
    chemin = ThisWorkbook.Path & "\"
    NomFichier = "Export_" & Sheets("EN TETE").[AK2] & "_" & Year(Now) & "_" & Month(Now) & "_" & Day(Now) & ".csv"
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets("CSV").Copy
    ActiveSheet.ListObjects(1).Unlist 'convertit le tableau en plage
    Rows(1).Delete 'supprime la ligne des en-têtes
    With ActiveWorkbook
        .SaveAs Filename:=chemin & NomFichier, FileFormat:=xlCSV, local:=True
        .Close savechanges:=False
    End With
    MsgBox Timer - t
End Sub
Elle s'exécute chez moi en 34 secondes.

La macro du post #39 de patricktoulon s'exécute en 136 secondes.

Pour la macro de Efgé je n'ai pas été jusqu'au bout...

Bonne nuit.
 

job75

XLDnaute Barbatruc
Cette macro est la plus rapide :
VB:
Sub ExportCSV()
    Dim t, chemin$, NomFichier$
    t = Timer
    'chemin = "P:\AP\5 B\5 CSV IMPORT\" ' Ne pas oublier "\" à la fin
    chemin = ThisWorkbook.Path & "\"
    NomFichier = "Export_" & Sheets("EN TETE").[AK2] & Format(Date, "_yyyy_mm_dd")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheets("CSV").ListObjects(1).DataBodyRange
        Workbooks.Add 'nouveau document
        [A1].Resize(.Rows.Count, .Columns.Count) = .Value 'copie les valeurs
    End With
    With ActiveWorkbook
        .SaveAs Filename:=chemin & NomFichier, FileFormat:=xlCSV, local:=True
        .Close savechanges:=False
    End With
    MsgBox Timer - t
End Sub
Toujours sur 900 000 lignes elle s'exécute chez moi en 13 secondes.

Re bonne nuit.
 

job75

XLDnaute Barbatruc
Bonjour patricktoulon, le forum,
quand on veut sauver une plage précise , un tableau structuré et qu'il y en a plusieurs sur la feuille ben on est chocolat
Allons allons, s'il y a plusieurs tableaux à copier il suffit de faire une boucle :
VB:
Sub ExportCSV()
    Dim t, chemin$, NomFichier$, F As Worksheet, n%, dest As Range
    t = Timer
    'chemin = "P:\AP\5 B\5 CSV IMPORT\" ' Ne pas oublier "\" à la fin
    chemin = ThisWorkbook.Path & "\"
    NomFichier = "Export_" & Sheets("EN TETE").[AK2] & Format(Date, "_yyyy_mm_dd")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set F = Sheets("CSV")
    For n = 1 To F.ListObjects.Count
        With F.ListObjects(n).DataBodyRange
            If n = 1 Then
                Workbooks.Add 'nouveau document
                Set dest = [A1]
            Else
                Set dest = dest.Offset(, F.ListObjects(n - 1).DataBodyRange.Columns.Count + 1)
            End If
            dest.Resize(.Rows.Count, .Columns.Count) = .Value 'copie les valeurs
        End With
    Next n
    With ActiveWorkbook
        .SaveAs Filename:=chemin & NomFichier, FileFormat:=xlCSV, local:=True
        .Close savechanges:=False
    End With
    MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
End Sub
A+
 

Pièces jointes

  • ZZ (1).xlsm
    23.1 KB · Affichages: 4

Discussions similaires

Réponses
2
Affichages
222
Réponses
13
Affichages
339

Statistiques des forums

Discussions
311 735
Messages
2 082 023
Membres
101 873
dernier inscrit
excellllll