Format cellules csv

bonjour,

dans la macro ci dessous (merci galopin01)

est il possible de conserver les formats des cellules d'origine ?

Sub csvv1()
Dim Tablo, iR%, i%, Tmp$, Sep$
'Dim iR As Integer, i As Integer, Tmp As String, Sep As String, Tablo

With Sheets(1)                    'On travaille directement sur la feuille export

    Sep = ";" 'ou ","
    iR = .Range("A65500").End(xlUp).Row  'Détermine la dernière ligne
    Tablo = .Range("A1:F" & iR)          'Mémorise le tout dans un tableau

     Open ThisWorkbook.Path & "\toto" & Format(Date, "dd-mmmm-yyyy") & "_" & Format(Time, "hh-mm") & ".csv" For Output As #1

    For i = 1 To iR
      If Tablo(i, 6) <> "" Then          'Recopie uniquement les lignes du tableau <> ""
     Tmp = ""
      For k = 1 To 6
      Tmp = Tmp & CStr(Tablo(i, k)) & Sep
      Next
      End If
    Print #1, Tmp
    Next

    DoEvents
    MsgBox "C'est fini !"
    Close #1

End With
End Sub

cordialement

re bonjour,

j'ai essayé de faire autrement pour mettre le format des 2 colonnes concernés en réouvrant le csv et le modifier une fois créé

et le résultat n'est....pas bon du tout...

Sub csvv2()
Dim Tablo, iR%, i%, Tmp$, Sep$

With Sheets(1)                    'On travaille directement sur la feuille export

    Sep = ","
    iR = .Range("A65500").End(xlUp).Row  'Détermine la dernière ligne
    Tablo = .Range("A1:D" & iR)          'Mémorise le tout dans un tableau
    'Open "Tournees-vracs.csv" For Output As #1
    'Open ThisWorkbook.Path & "\toto.csv" For Output As #1
     Open ThisWorkbook.Path & "\toto" & ".csv" For Output As #1
    For i = 1 To iR
      If Tablo(i, 4) <> "" Then          'Recopie uniquement les lignes du tableau <> ""
     Tmp = ""
      For k = 1 To 4
      Tmp = Tmp & CStr(Tablo(i, k)) & Sep
      Next
      End If
    Print #1, Tmp
    Next
    DoEvents
    MsgBox "C'est fini !"
    Close #1

End With
Workbooks.Open Filename:= _
 ThisWorkbook.Path & "\toto" & ".csv"
    Columns("C:C").NumberFormat = "#,##0"
    Columns("D:D").Select
    Selection.NumberFormat = "m/d/yyyy"
    Selection.Replace What:="/", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "General"
    Range("C6").Select
End Sub

là je suis un peu perdu

si quelqu'un a déjà eu le problème merci d'avance

bonsoir,

essaie ceci

Sub csvv2()
Dim Tablo, iR%, i%, Tmp$, Sep$
Dim formatxls(4)

With Sheets(1)                    'On travaille directement sur la feuille export
 For i = 1 To 4
  formatxls(i) = .Cells(2, i).NumberFormat
 Next i
    Sep = ","
    iR = .Range("A65500").End(xlUp).Row  'Détermine la dernière ligne
   Tablo = .Range("A1:D" & iR)          'Mémorise le tout dans un tableau
   'Open "Tournees-vracs.csv" For Output As #1
   'Open ThisWorkbook.Path & "\toto.csv" For Output As #1
    Open ThisWorkbook.Path & "\toto" & ".csv" For Output As #1
    For i = 1 To iR
      If Tablo(i, 4) <> "" Then          'Recopie uniquement les lignes du tableau <> ""
    Tmp = ""
      For k = 1 To 4
      Select Case UCase(formatxls(k))
      Case "GENERAL"
      Tmp = Tmp & CStr(Tablo(i, k)) & Sep
      Case Else
      Tmp = Tmp & Format(Tablo(i, k), formatxls(k)) & Sep
      End Select
      Next
      End If
    Print #1, Tmp
    Next
    DoEvents
    MsgBox "C'est fini !"
    Close #1

End With
End Sub

MERCI h2so4

c'est super!!

j'y étais depuis un moment !!

une dernière petite question , le csv est comme il faut mais juste un petit détail

si je vérifie avec Notepad mon csv toutes les lignes on un ; a la fin

est il possible de ne pas le mettre a l'enregistrement ?

cordialement

bonsoir,

j'ai changé l'instruction print #1,tmp

Sub csvv2()
Dim Tablo, iR%, i%, Tmp$, Sep$
Dim formatxls(4)

With Sheets(1)                    'On travaille directement sur la feuille export
 For i = 1 To 4
  formatxls(i) = .Cells(2, i).NumberFormat
 Next i
    Sep = ","
    iR = .Range("A65500").End(xlUp).Row  'Détermine la dernière ligne
   Tablo = .Range("A1:D" & iR)          'Mémorise le tout dans un tableau
   'Open "Tournees-vracs.csv" For Output As #1
   'Open ThisWorkbook.Path & "\toto.csv" For Output As #1
    Open ThisWorkbook.Path & "\toto" & ".csv" For Output As #1
    For i = 1 To iR
      If Tablo(i, 4) <> "" Then          'Recopie uniquement les lignes du tableau <> ""
    Tmp = ""
      For k = 1 To 4
      Select Case UCase(formatxls(k))
      Case "GENERAL"
      Tmp = Tmp & CStr(Tablo(i, k)) & Sep
      Case Else
      Tmp = Tmp & Format(Tablo(i, k), formatxls(k)) & Sep
      End Select
      Next
      End If
    Print #1, left(Tmp,len(tmp)-1)
    Next
    DoEvents
    MsgBox "C'est fini !"
    Close #1

End With
End Sub

t'es trop fort

merci pour ton aide !!!!!!