VBA - Enregistrer formules avant export CSV

Et v'la l'travail:

Option Explicit
Sub ExportCSV()
    Const cSep = ","
    Dim plage As Range
    Dim oRow As Range, oCell As Range
    Dim oTS As Object, oFS As Object
    Dim sFilename As String
    Dim sBuffer As String
    Dim oSheet As Worksheet
    Dim lLastrow As Long
    Dim lFirstCol As Long, lLastCol As Long
    Dim aValues() As String, sValue As String, i As Integer

    Set oSheet = ActiveSheet
    lLastrow = oSheet.UsedRange.Rows.Count
    lFirstCol = Letter2Number("T")
    lLastCol = Letter2Number("AQ")

    ReDim aValues((lLastCol - lFirstCol) + 1)

    With oSheet
        Set plage = .Range(.Cells(1, lFirstCol), .Cells(lLastrow, lLastCol))
    End With

    sFilename = ThisWorkbook.Path & "\" & "ExportToCRM_" & Format(Now(), "yyyymmdd-HHMM") & ".csv"

    Set oFS = CreateObject("Scripting.FileSystemObject")
    Set oTS = oFS.CreateTextFile(sFilename, False)

    For Each oRow In plage.Rows

        For i = 1 To oRow.Columns.Count
            Set oCell = oRow.Cells(1, i)
            sValue = Replace(oCell.Value, ",", "")

            If sValue = "0" Then
                sValue = 0
            End If

            aValues(i - 1) = sValue
        Next
        sBuffer = Join(aValues(), cSep)
        oTS.WriteLine sBuffer
    Next

    oTS.Close

    Set oTS = Nothing
    Set oFS = Nothing

End Sub
Function Letter2Number(zLetter As String) As Long
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

    Letter2Number = Range(zLetter & 1).Column

End Function

Euh...envoi précédent un chouïa erroné...excuses...Le bon code :

Sub ExportCSV()
    Const cSep = ","
    Dim plage As Range
    Dim oRow As Range, oCell As Range
    Dim oTS As Object, oFS As Object
    Dim sFilename As String
    Dim sBuffer As String
    Dim oSheet As Worksheet
    Dim lLastrow As Long
    Dim lFirstCol As Long, lLastCol As Long
    Dim aValues() As String, sValue As String, i As Integer

    Set oSheet = ActiveSheet
    lLastrow = oSheet.UsedRange.Rows.Count
    lFirstCol = Letter2Number("T")
    lLastCol = Letter2Number("AQ")

    ReDim aValues((lLastCol - lFirstCol) + 1)

    With oSheet
        Set plage = .Range(.Cells(1, lFirstCol), .Cells(lLastrow, lLastCol))
    End With

    sFilename = ThisWorkbook.Path & "\" & "ExportToCRM_" & Format(Now(), "yyyymmdd-HHMM") & ".csv"

    Set oFS = CreateObject("Scripting.FileSystemObject")
    Set oTS = oFS.CreateTextFile(sFilename, False)

    For Each oRow In plage.Rows

        For i = 1 To oRow.Columns.Count
            Set oCell = oRow.Cells(1, i)
            sValue = Replace(oCell.Value, ",", "")

            If sValue = "0" Then
                sValue = ""
            End If

            aValues(i - 1) = sValue
        Next
        sBuffer = Join(aValues(), cSep)
        oTS.WriteLine sBuffer
    Next

    oTS.Close

    Set oTS = Nothing
    Set oFS = Nothing

End Sub
Function Letter2Number(zLetter As String) As Long
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

    Letter2Number = Range(zLetter & 1).Column

End Function

Comportement impeccable ! Merci beaucoup

GVIALLES,

J'aimerais également garder les numéros de téléphone au format 00##" "#" "##" "##" "##" "## car lors de l'export, il me supprime les 2 premiers 0 ainsi que tous les espaces.

Pourrais-tu m'indiquer comment faire ?

Fistname...,

Curieux, dans mon test, les téléphones sont bien conservés au format de la cellule :

JOE,JOE,01 02 03 04 05,,,,Appel,,,Joe,,,69007,LYON,FRANCE,,,,,,,,,,

Peux-tu me dire comment sont stockés les numéros de tel dans la feuille EXCEL?

Ils sont enregistrés au même format que celui cité précédemment : "0033 1 23 45 67 89".

Lorsqu'ils sont exportés en CSV je retrouve 33123456789

Bonjour Firstname...

OK compris...

Du coup, nouvelle version de la proc d'export :

Option Explicit
Sub ExportCSV()
    Const cSep = ","
    Dim plage As Range
    Dim oRow As Range, oCell As Range
    Dim oTS As Object, oFS As Object
    Dim sFilename As String
    Dim sBuffer As String
    Dim oSheet As Worksheet
    Dim lLastrow As Long
    Dim lFirstCol As Long, lLastCol As Long
    Dim aValues() As String, sValue As String, i As Integer

    Set oSheet = ActiveSheet
    lLastrow = oSheet.UsedRange.Rows.Count
    lFirstCol = Letter2Number("T")
    lLastCol = Letter2Number("AQ")

    ReDim aValues((lLastCol - lFirstCol) + 1)

    With oSheet
        Set plage = .Range(.Cells(1, lFirstCol), .Cells(lLastrow, lLastCol))
    End With

    sFilename = ThisWorkbook.Path & "\" & "ExportToCRM_" & Format(Now(), "yyyymmdd-HHMM") & ".csv"

    Set oFS = CreateObject("Scripting.FileSystemObject")
    Set oTS = oFS.CreateTextFile(sFilename, False)

    For Each oRow In plage.Rows

        For i = 1 To oRow.Columns.Count
            Set oCell = oRow.Cells(1, i)
            sValue = Replace(oCell.Value, ",", "")

            If Len(oCell.NumberFormat) > 0 Then
                sValue = Format(sValue, oCell.NumberFormat)
            End If

            If sValue = "0" Then
                sValue = ""
            End If

            aValues(i - 1) = sValue
        Next
        sBuffer = Join(aValues(), cSep)
        oTS.WriteLine sBuffer
    Next

    oTS.Close

    Set oTS = Nothing
    Set oFS = Nothing

End Sub
Function Letter2Number(zLetter As String) As Long
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

    Letter2Number = Range(zLetter & 1).Column

End Function

Merci c'est parfait !