Convertir une zone d'une feuille d'un fichier Excel en CSV

Bonjour ! Je vous explique la situation, j'ai un fichier Excel, une feuille avec les données (Feuil1) et une feuille avec le bouton d'une macron (Feuil2), ce que je veux c'est que quand j'active le bouton, cela crée un nouveau fichier CSV avec les données de la Feuil1, comment faire ?

J'ai déjà ce code, mais ce code selectionne un fichier Excel qu'on choisit et le convertit en CSV (en créant un nouveau fichier CSV)

Sub Main()
    Dim fileToConvertInCSV As String
    Dim fileToConvertInUTF8 As String
    Dim Result

    Do Until Result = vbNo

        fileToConvertInCSV = FileSelected
        fileToConvertInUTF8 = CSVConverted(fileToConvertInCSV)
        Call WriteANSItoUF8WithoutBOM(fileToConvertInUTF8, fileToConvertInUTF8)
        Result = MsgBox("Do you want to select another file ?", vbQuestion + vbYesNo)
    Loop

    'améliorations à implémenter
    'File Selected => n'autoriser que la sélection Excel
    'ConvertUTF8 => convertir en UTF8 sans N
End Sub

Function FileSelected() As String
    'Function to Open a file

    Dim fd As Office.FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
       .Filters.Clear
       .Filters.Add "Excel Files", "*.xlsx?,*.xls?,*.xlsb?,*.xlsm?", 1
       .Title = "Choose an Excel file"
       .AllowMultiSelect = False

       If .Show = True Then
           FileSelected = .SelectedItems(1)
       End If
    End With

End Function

Function CSVConverted(fileToConvert As String) As String

    Dim toConvertFile As String
    Dim convertedFile As String
    Dim Rows As Long
    Dim Cols As Long
    Dim J As Long
    Dim K As Long
    Dim sTemp As String
    Dim sSep As String
    Dim wb As Workbook

    Const adCrLf                As Long = -1
    Const adModeUnknown         As Long = 0
    Const adSaveCreateOverWrite As Long = 2
    Const adTypeText            As Long = 2

    sSep = ";!@#;" 'Specify the separator to be used

    toConvertFile = fileToConvert

    Workbooks.Open toConvertFile
    Sheets(1).Activate

    Dim fileExtension As String
    fileExtension = Right(toConvertFile, Len(toConvertFile) - InStrRev(toConvertFile, "."))

    If fileExtension = "xlsm" Or fileExtension = "xlsx" Or fileExtension = ".xlsb" Or fileExtension = ".xls" Then

        toConvertFile = Mid(toConvertFile, 1, Len(toConvertFile) - Len(fileExtension))
        convertedFile = toConvertFile & ".csv"
        Open convertedFile For Output As 1

        With ActiveSheet
            'Number of rows to export is based on the contents
            'of column J. If it should be based on a different
            'column, change the following line to reflect the
            'column desired.
            Rows = .Cells(.Rows.Count, "J").End(xlUp).Row
            For J = 1 To Rows
                sTemp = ""
                Cols = .Cells(J, .Columns.Count).End(xlToLeft).Column
                For K = 1 To Cols
                    sTemp = sTemp & .Cells(J, K).Value
                    If K < Cols Then sTemp = sTemp & sSep
                Next
                Print #1, sTemp
            Next J
        End With

        Close 1

        sTemp = "There were " & Rows & " rows of data written "
        sTemp = sTemp & "to this file:" & vbCrLf & toConvertFile
    Else
        sTemp = "This macro needs to be run on a workbook "
        sTemp = sTemp & "stored in the XLSX, XLSM, XLSB or XLS format."
    End If

    ActiveWorkbook.Close

    'Dim wbName As String
    'wbName = Right(toConvertFile, Len(toConvertFile) - InStrRev(toConvertFile, "\"))

    'For Each wb In Workbooks
    '    If wb.Name = wbName Then
    '        Workbooks.Close wbName
    '        Exit Sub
    '    End If
    'Next

    MsgBox sTemp

    CSVConverted = convertedFile

End Function

Merci d'avance de votre aide !

Bonjour

Voila qui devrait faire l'affaire

Sub ExportCSV()
  Dim nomFichier As String

  nomFichier = "nom du nouveau fichier.csv"
  ThisWorkbook.Worksheets("nom de la feuille").Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=nomFichier, FileFormat:=xlCSV, local:=True
  ActiveWorkbook.Close
  Application.DisplayAlerts = True
End Sub

Bonjour, j'aime bien ce code, mais comment faire pour que le nouveau fichier CSV dans dans le même chemin que le fichier de base ?

sachant que le fichier de base on connait pas forcement le chemin

Donc peut-être spécifier "ThisWorkbooks.Path"

Public Sub ExportWorksheetAndSaveAsCSV()

Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Dim Path As String
Dim FileName As String

Set shtToExport = ThisWorkbook.Worksheets("Deliveries")     'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
Path = ThisWorkbook.Path
FileName = "test"
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False                       'Possibly overwrite without asking
wbkExport.SaveAs FileName:=Path & FileName & ".csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False

End Sub

J'ai tenté un truc mais ça me retourne rien ...

Sub ExportCSV()
  Dim nomFichier As String
  Dim chemin As String

  chemin = ThisWorkbook.Path & "\"
  nomFichier = chemin & "test.csv"

  ThisWorkbook.Worksheets("élèves").Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=nomFichier, FileFormat:=xlCSV, local:=True
  ActiveWorkbook.Close
  Application.DisplayAlerts = True
End Sub

Merci beaucoup mais il faudrait juste un dernier petit détail, enfaite ça me retourne un fichier CSV mais avec encodage ANSI, or je veux encodage UTF-8

J'ai ce code qui transforme un ANSI en UTF-8

Sub WriteANSItoUF8WithoutBOM(fileToConvert, fileToSave As String)

    Dim fileToConvertPath, fileToSavePath As String

    fileToConvertPath = fileToConvert
    fileToSavePath = fileToSave

    Set UTFStream = CreateObject("adodb.stream")
    Set ANSIStream = CreateObject("adodb.stream")
    Set BinaryStream = CreateObject("adodb.stream")

    ANSIStream.Type = adTypeText
    ANSIStream.Mode = adModeReadWrite
    ANSIStream.Charset = "iso-8859-1"
    ANSIStream.Open
    ANSIStream.LoadFromFile fileToConvertPath  'ANSI File

    UTFStream.Type = adTypeText
    UTFStream.Mode = adModeReadWrite
    UTFStream.Charset = "UTF-8"
    UTFStream.Open
    ANSIStream.CopyTo UTFStream

    UTFStream.Position = 3 'skip BOM
    BinaryStream.Type = adTypeBinary
    BinaryStream.Mode = adModeReadWrite
    BinaryStream.Open

    'Strips BOM (first 3 bytes)
    UTFStream.CopyTo BinaryStream

    BinaryStream.SaveToFile fileToSavePath, adSaveCreateOverWrite
    BinaryStream.Flush
    BinaryStream.Close
End Sub

Mais comment je fais pour le faire avec mon code de base ?

Sub Main()
    Dim fileToConvertInUTF8 As String

    fileToConvertInUTF8 = ExportCSV()
    Call WriteANSItoUF8WithoutBOM(fileToConvertInUTF8, fileToConvertInUTF8)
End Sub

Sub ExportCSV()
  Dim nomFichier As String
  Dim chemin As String
  Dim convertedFile As String

  chemin = ThisWorkbook.Path & "\"
  nomFichier = chemin & "test.csv"

  ThisWorkbook.Worksheets("Deliveries").Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs FileName:=nomFichier, FileFormat:=xlCSV, local:=True
  ActiveWorkbook.Close
  Application.DisplayAlerts = True

End Sub

JE tente ça mais ça marche pas, ça me met Fonction ou Variable attendu ...;

Après quelques recherches voila qui semble faire le job

Sub ExportCSV()
  Dim nomFichier As String
  Dim chemin As String

  chemin = ThisWorkbook.Path & "\"
  nomFichier = chemin & "test.csv"

  ThisWorkbook.Worksheets("élèves").Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=nomFichier, FileFormat:=xlCSV, local:=True
  ActiveWorkbook.Close
  Application.DisplayAlerts = True

  Dim sInFilePath As String
  Dim sOutFilePath As String

   sInFilePath = nomFichier
   sOutFilePath = nomFichier

  Call convertTxttoUTF(sInFilePath, sOutFilePath)

End Sub

Sub convertTxttoUTF(sInFilePath As String, sOutFilePath As String)
    Dim objFS  As Object
    Dim iFile       As Double
    Dim sFileData   As String

    'Init
    iFile = FreeFile
    Open sInFilePath For Input As #iFile
        sFileData = Input$(LOF(iFile), iFile)
        sFileData = sFileData & vbCrLf
    Close iFile

    'Open & Write
    Set objFS = CreateObject("ADODB.Stream")
    objFS.Charset = "utf-8"
    objFS.Open
    objFS.WriteText sFileData

    'Save & Close
    objFS.SaveToFile sOutFilePath, 2   '2: Create Or Update
    objFS.Close

    'Completed
    Application.StatusBar = "Completed"
End Sub

Yes, merci beaucoup !

Mieux encore au niveau de l'encodage

Option Explicit

Sub ExportCSV()
  Dim nomFichier As String
  Dim chemin As String

  chemin = ThisWorkbook.Path & "\"
  nomFichier = chemin & "test.csv"

  ThisWorkbook.Worksheets("élèves").Copy
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=nomFichier, FileFormat:=xlCSV, local:=True
  ActiveWorkbook.Close
  Application.DisplayAlerts = True

  Dim nmF$
  nmF = chemin & "test.csv"
  Call WriteANSItoUF8WithoutBOM(nomFichier)

End Sub

Sub WriteANSItoUF8WithoutBOM(nomFichier As String)
    Dim UTFStream As New ADODB.Stream
    Dim ANSIStream As New ADODB.Stream
    Dim BinaryStream As New ADODB.Stream

    ANSIStream.Type = adTypeText
    ANSIStream.Mode = adModeReadWrite
    ANSIStream.Charset = "iso-8859-1"
    ANSIStream.Open
    ANSIStream.LoadFromFile nomFichier

    UTFStream.Type = adTypeText
    UTFStream.Mode = adModeReadWrite
    UTFStream.Charset = "UTF-8"
    UTFStream.Open
    ANSIStream.CopyTo UTFStream

    UTFStream.Position = 3 'skip BOM
    BinaryStream.Type = adTypeBinary
    BinaryStream.Mode = adModeReadWrite
    BinaryStream.Open

    'Strips BOM (first 3 bytes)
    UTFStream.CopyTo BinaryStream

    BinaryStream.SaveToFile nomFichier, 2
    BinaryStream.Flush
    BinaryStream.Close
End Sub