XL 2016 VBA - Extraire une feuille pour l'enregistrer en .csv (avec séparateur point virgule) puis l'enregistrer en .txt

Karim48 · 26 Mai 2021

Bonjour à tous,

J'ai créé le code ci-dessous qui aurait dû me permettre à partir de fichiers source de remplir le fichier cible ci-joint.

[
Sub recup_donnees()

Workbooks("Liste des salariés v1.xlsm").Worksheets("_DATA_MASTER_TD").Range("B6:H5000").Copy Destination:=Workbooks("Liste des salariés v1.xlsm").Worksheets("_DATA_MASTER").Range("a2")
Workbooks("Liste des salariés v1.xlsm").Worksheets("_DATA_MASTER_MG").Range("F6:F5000").Copy Destination:=Workbooks("Liste des salariés v1.xlsm").Worksheets("_DATA_MASTER").Range("I2")
Workbooks("Liste des salariés v1.xlsm").Worksheets("_DATA_MASTER").Range("A2", Range("A2").End(xlDown)).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo
Workbooks("Liste des salariés v1.xlsm").Worksheets("_DATA_MASTER").Range("A2:A5000").Copy Destination:=Workbooks("Liste des salariés v1.xlsm").Worksheets("Employees Template()").Range("E5")
Workbooks("Liste des salariés v1.xlsm").Worksheets("_DATA_MASTER").Range("B2:B5000").Copy Destination:=Workbooks("Liste des salariés v1.xlsm").Worksheets("Employees Template()").Range("B5")
Workbooks("Liste des salariés v1.xlsm").Worksheets("_DATA_MASTER").Range("C2:C5000").Copy Destination:=Workbooks("Liste des salariés v1.xlsm").Worksheets("Employees Template()").Range("D5")
Workbooks("Liste des salariés v1.xlsm").Worksheets("Employees Template()").Range("A5:EG5000").Copy Destination:=Workbooks("Liste des salariés v1.xlsm").Worksheets("Employees update").Range("A2")
Workbooks("Liste des salariés v1.xlsm").Worksheets("Employees update").SaveAs Filename:="Employees update", FileFormat:=xlCSV
Workbooks("Employees update").Close False
Application.DisplayAlerts = True
Workbooks("Liste des salariés v1.xlsm").Close False
End Sub
]

Dans l'absolu, j'aurais aimé :
- enregistrer l'onglet "Employees update" dans le même dossier que le fichier cible mais il est enregistré dans "c:/documents".
- qu'Excel écrase systématiquement la dernière version existante en .csv de la feuille "Employees update" en la remplaçant par la nouvelle sans modifier mon fichier cible ("Liste de salariés v1")
- après avoir enregistré la version .csv (avec séparateur point virgule), l'enregistrer sous le même nom mais en version .txt

Le but final étant d'envoyer ce fichier .txt vers un serveur ftp sécurisé (que l'éditeur de logiciel ne m'a pas encore transmis), je reviendrai surement vers vous plus tard (il parait qu'on ne change pas une équipe qui gagne mais je regarderai avant si je ne peux me débrouiller seul).

Un gros merci par avance parce que j'avance plus là

Karim

kiki29 · 27 Mai 2021

Salut, à adapter à ton contexte

kiki29 · 28 Mai 2021

Re, qqch comme ceci, à adapter à ton contexte
Feuil1 étant le CodeName de la feuille dont le nom d'onglet est "_DATA_MASTER_TD" par exemple.

VB:

Option Explicit

Sub Sauver_XLSX_TXT()
Dim sNomFeuille As String
Dim Wkb As Workbook
Dim sDossierXLSX As String, sDossierTXT As String
Dim sExt1 As String, sExt2 As String, Dep As Currency
Dim sDossierSauvegardeXLSX As String, sDossierSauvegardeTXT As String

    Application.StatusBar = ""
    Dep = Timer
   
    sDossierSauvegardeXLSX = "XLSX"
    sDossierSauvegardeTXT = "TXT"
    sDossierXLSX = ThisWorkbook.Path & "\" & sDossierSauvegardeXLSX
    sDossierTXT = ThisWorkbook.Path & "\" & sDossierSauvegardeTXT
    sExt1 = ".xlsx"
    sExt2 = ".txt"
   
    Application.ScreenUpdating = False
    sNomFeuille = Feuil1.Name
    Set Wkb = Workbooks.Add
    Application.DisplayAlerts = False
    Feuil1.UsedRange.Copy Wkb.Worksheets(1).Range("A1")
    With Wkb
        .Worksheets(1).UsedRange.EntireColumn.AutoFit
        .Worksheets(1).Range("A1").Select
        .SaveAs Filename:=sDossierXLSX & "\" & sNomFeuille & sExt1, _
                FileFormat:=xlOpenXMLWorkbook

        .SaveAs Filename:=sDossierTXT & "\" & sNomFeuille & sExt2, _
                FileFormat:=xlText
        .Close
    End With
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Set Wkb = Nothing
    DoEvents
    Application.ScreenUpdating = True
    Application.StatusBar = "Sauvegarde terminée : " & Format(Timer - Dep, "0.00 s")
End Sub

Karim48 · 7 Juin 2021

Merci pour cette réponse, je ne l'avais pas vue. Je ferai un test puis un retour pour vous tenir au courant. Merci encore.

XL 2016 VBA - Extraire une feuille pour l'enregistrer en .csv (avec séparateur point virgule) puis l'enregistrer en .txt

Karim48

XLDnaute Nouveau

kiki29

XLDnaute Barbatruc

kiki29

XLDnaute Barbatruc

Karim48

XLDnaute Nouveau

Discussions similaires