XL 2016 Création fichier CSV

[ZZ59264]

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,

 

[ZZ59264]

Pourquoi souhaitez vous que je teste ce code dans un module, car le chemin a été trouvé 😉

J'ai quand même testé et il me retourne que le dossier existe 😉

Merci pour la colonne vide 😉

Cordialement,

 

[patricktoulon]

si le dossier existe alors il ne devrait pas y avoir de probleme
colonne vide corrigée

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

 

[patricktoulon]

et pour etre certain de pas faire de sotise dans le replace la correction devrait etre ça

texte = Replace(Replace(texte, vbTab, ";"), ";  ;", ";;;"): End With

la colonne vide est donc conservée dans le csv

 

[ZZ59264]

si le dossier existe alors il ne devrait pas y avoir de probleme
colonne vide corrigée

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,

 

[ZZ59264]

Désolé je l'ai testé et non la colonne vide disparait ...

 

[patricktoulon]

re
la colonne y est bien dans le texte obtenu

 

[ZZ59264]

re
la colonne y est bien dans le texte obtenu
Regarde la pièce jointe 1125168

Oui mais lorque j'ouvre le fichier CSV la colonne vide n'y es pas pourtant, je ne comprends pas ...

 

[ZZ59264]

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,

 

[patricktoulon]

re

 

[ZZ59264]

Bonsoir,

Après avoir cherché le pourquoi du comment, j'ai enfin trouvé mon erreur,

Sur mon fichier de travail, la colonne D était masqué lol

Tout fonctionne parfaitement,

Merci pour tout,

Cordialement,

 

[patricktoulon]

ravi pour toi😉

 

[job75]

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 :

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]

Cette macro est la plus rapide :

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.

 

[patricktoulon]

Bonjour @job75 quand on a toute une feuille a enregistrer en csv c'est effectivement la meilleure solution mais 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

 

[job75]

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 :

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+