Macro exporter une feuille dans un nouveau fichier CSV

Bonjour à tous,

j'ai un fichier excel composé de trois feuilles.

J'aimerais pouvoir créer une macro permettant d'enregistrer le contenu de la 3ème page seulement en csv dans un dossier que je choisirai.

j'ai commencé une esquisse en utilisant l'enregistreur de macro mais ca enregistre le classeur entier au format csv.

Une âme charitable pourrait-elle m'aider ?

Merci d'avance et bonne journée

Orianne

J'ai avancé en adaptant un morceau de code trouvé sur internet.

Le code se lance correctement mais le fichier est introuvable dans le dossier de destination.

Quelqu'un aurait-il la bonté de me dépanner

Sub exporter csv()
    Dim nom$, chemin$, i&, fd As Object, fichier$, rep As Object
    Set rep = Application.FileDialog(msoFileDialogFolderPicker)
    If rep.Show <> 0 Then
        chemin = rep.SelectedItems(1)
    Else
        MsgBox "Vous n'avez Choisi aucun Dossier", , "Manque de Choix de Dossier": Exit Sub
    End If
    Application.ScreenUpdating = False
    With ActiveWorkbook
    nom = "Fichier Pv syst"
    .Sheets("feuille 3").ExportAsFixedFormat Type:=xlTypeCSV, Filename:=chemin & nom & ".CSV"
    End With

    Application.ScreenUpdating = 1
    MsgBox "Travail terminé." & Chr(13) & "Le fichier a bien été créé dans le " & _
           "dossier: " & chemin, vbInformation, "Fiches enregistrées"
End Sub

Bonjour

deja évite les espace

voila une macro pour faire des CSV

le CSV se trouve dans le même répertoire que ton fichier excel

Sub ExportCsv()
Dim Plage As Object, oL As Object, oC As Object
Dim Tmp$, Sep$
Dim Fichier$, Chemin$, CheminFiche$, Nlig&
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlManual
   End With
'Fichier = "Base" & ".csv"
Fichier = "Fichier_Pv_syst" & ".csv"

Chemin = ActiveWorkbook.Path & Application.PathSeparator
CheminFiche = Chemin & Fichier
Nlig = Cells(Rows.Count, 1).End(xlUp).Row
Sep = ";"
   Set Plage = Range("A1:B" & Nlig)
      Open CheminFiche For Output As #1
         For Each oL In Plage.Rows
            Tmp = ""
               For Each oC In oL.Cells
                  Tmp = Tmp & CStr(oC.Text) & Sep
               Next
            Print #1, Left(Tmp, Len(Tmp) - 1)
         Next
      Close
   Set Plage = Nothing
MsgBox "Export Base Terminer", vbInformation, "Admin"
    With Application
       .ScreenUpdating = True
       .Calculation = xlCalculationAutomatic
       .EnableEvents = True
       .Goto [A1], True
    End With
End Sub

A+

Maurice

Bonjour,

Une autre proposition à étudier.

Cdlt.

Public Sub SaveAsCSV()
Dim wb As Workbook, ws As Worksheet
Dim strPath As String, strFilename As String
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("feuille 3")
    strPath = wb.Path & Application.PathSeparator
    strFilename = "TEST.csv"
    ws.Copy
    With ActiveWorkbook
        .SaveAs Filename:=strPath & strFilename, _
                FileFormat:=xlCSV, _
                local:=True '? adapter
        .Close savechanges:=False
    End With
End Sub

Merci beaucoup Maurice,

ca fonctionne bien effectivement .

Une amélioration serait de pouvoir choisir l'emplacement...

j'ai essayé de changer le code mais cela ne fonctionne pas

Une idée ?

Sub ExportCsv()
Dim Plage As Object, oL As Object, oC As Object
Dim Tmp$, Sep$
Dim Fichier$, Chemin$, CheminFiche$, Nlig&
Sheets("5. export PV syst").Select
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlManual
   End With
'Fichier = "Base" & ".csv"
Fichier = "Fichier_Pv_syst" & ".csv"
Set rep = Application.FileDialog(msoFileDialogFolderPicker)
    If rep.Show <> 0 Then
        Chemin = rep.SelectedItems()
    Else
        MsgBox "Vous n'avez Choisi aucun Dossier", , "Manque de Choix de Dossier": Exit Sub
    End If
    Application.ScreenUpdating = False
CheminFiche = Chemin & Fichier
Nlig = Cells(Rows.Count, 1).End(xlUp).Row
Sep = ";"
   Set Plage = Range("A1:B" & Nlig)
      Open CheminFiche For Output As #1
         For Each oL In Plage.Rows
            Tmp = ""
               For Each oC In oL.Cells
                  Tmp = Tmp & CStr(oC.Text) & Sep
               Next
            Print #1, Left(Tmp, Len(Tmp) - 1)
         Next
      Close
   Set Plage = Nothing
MsgBox "Le fichier de conso CSV au pas de temps horaire est créé ", vbInformation, "Admin"
    With Application
       .ScreenUpdating = True
       .Calculation = xlCalculationAutomatic
       .EnableEvents = True
       .Goto [A1], True
    End With
End Sub

bonjour

petit bug

A voir

Chemin = rep.SelectedItems(1) & "\"

A+

Maurice

<excellent !

<merci beaucoup pour ton temps et ta patience

l'erreur venait bien de l'oubli : "\"

Chemin = rep.SelectedItems(1) & "\"