Export csv

Question

Bjr,

Je cherche à finaliser l'export d'une feuille xls en csv avec les contraintes suivantes :

chaque ligne doit commencer par

et se terminer par

),

chaque cellule doit être encapsulée par

et séparée par

En fait, je veux obtenir un format à ajouter à une requête sql :

INSERT INTO table VALUES

J'obtiens bien le résultat souhaité sauf pour la dernière cellule.

('25091','CALMES','Jean Louis','1789','1790','','','','','','','','',"''),"

où j'ai des guillemets doubles parasitaires

," ''), "

NB : même résultat si les 2 dernières cellules sont remplies.

Voici le code

Public Plage As Object
Public nomfichier As String

Sub maires()
Dim code As String
Dim nom, prenom, lieuN, lieuM, lieuD, nomC, prenomC, obs As String
Dim debutM, finM, dateN, dateM, dateD As String
derLign = Range("A" & Rows.Count).End(xlUp).Row

Sheets("Feuil1").Select
Range("D2").Select
nomfichier = ActiveCell.Value
Cells(4, 2).Select
        code = ActiveCell.Value

Range("A9:M" & derLign).Select
    With Selection
        .Replace What:=";", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        .Replace What:="'", Replacement:="\'", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End With

For i = 9 To derLign
    Cells(i, 1).Select
        nom = ActiveCell.Value

     Cells(i, 2).Select
        prenom = ActiveCell.Value

    Cells(i, 3).Select
        debutM = ActiveCell.Value

    Cells(i, 4).Select
        finM = ActiveCell.Value

    Cells(i, 5).Select
        dateN = ActiveCell.Value

    Cells(i, 6).Select
        lieuN = ActiveCell.Value

    Cells(i, 7).Select
        dateM = ActiveCell.Value

    Cells(i, 8).Select
        lieuM = ActiveCell.Value

    Cells(i, 9).Select
        dateD = ActiveCell.Value

    Cells(i, 10).Select
        lieuD = ActiveCell.Value

    Cells(i, 11).Select
        nomC = ActiveCell.Value

    Cells(i, 12).Select
        prenomC = ActiveCell.Value

    Cells(i, 13).Select
        obs = ActiveCell.Value
'        If obs = "" Then
'        obs = " "
'        End If

Sheets("Feuil2").Select
With Selection
    .Cells(i, 1).Value = "('" & code & "'"
    .Cells(i, 2).Value = "''" & nom & "'"
    .Cells(i, 3).Value = "''" & prenom & "'"
    .Cells(i, 4).Value = "''" & debutM & "'"
    .Cells(i, 5).Value = "''" & finM & "'"
    .Cells(i, 6).Value = "''" & dateN & "'"
    .Cells(i, 7).Value = "''" & lieuN & "'"
    .Cells(i, 8).Value = "''" & dateM & "'"
    .Cells(i, 9).Value = "''" & lieuM & "'"
    .Cells(i, 10).Value = "''" & dateD & "'"
    .Cells(i, 11).Value = "''" & lieuD & "'"
    .Cells(i, 12).Value = "''" & nomC & "'"
    .Cells(i, 13).Value = "''" & prenomC & "'"
    .Cells(i, 14).Value = "''" & obs & "'),"
End With
ActiveWorkbook.Sheets("Feuil1").Select
    Next
ActiveWorkbook.Sheets("Feuil2").Select
'Call supVide
derniereligne = Range("A" & Rows.Count).End(xlUp).Row
Set Plage = ActiveSheet.Range("A1:N" & derniereligne)
Call CSV_SQL
End Sub

Sub CSV_SQL()
'
' Créer un nv classeur .sql pour import
'
Dim Extension As String
Extension = ".csv"
CheminFichier = "D:\essai\" & nomfichier & Extension
derniereligne = Range("A" & Rows.Count).End(xlUp).Row
Set Plage = ActiveSheet.Range("A1:N" & derniereligne)
    Plage.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    DoEvents
    ActiveWorkbook.SaveAs Filename:=CheminFichier, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    DoEvents
    ActiveWindow.Close savechanges:=True
End Sub

Je mets mon fichier en copie

8essai.xlsm (27.74 Ko)

Merci de votre aide

ric · Answer

J'essaierai en enlevant la , à l'avant-dernier caractère de cette ligne ... .Cells(i, 14).Value = "''" &amp; obs &amp; "')," donnant ceci ... .Cells(i, 14).Value = "''" &amp; obs &amp; "')" ric...