Option Explicit

Sub ExportSheet2CSV(Optional ByVal cFileName = "", _
  Optional ByVal cDelimiter = ",", Optional ByVal cTextQualifier = "", Optional ByVal cDecimalSeparator = ".", _
  Optional ByVal nStartRow = 1, Optional ByVal nStartCol = 1, _
  Optional ByVal vCutHeader As Variant = True, _
  Optional ByVal cFormatDateTime = "YYYY-MM-DD hh:mm:ss", Optional ByVal cTypeQualifier = "")

' Параметры для сохраняемого файла
'    cFileName = "" ' имя файла экспорта, по умолчанию - имя активного листа
'    cDelimiter = "," ' разделитель полей
'    cTextQualifier = "" ' квалификатор символьных полей, по умолчанию экв. xlTextQualifierNone для совместимости с SQL
'    cDecimalSeparator = "." ' символ десятичной точки, по умолчанию экв. "dot" для совместимости
'    nStartRow = 1 ' Номер строки на листе - первая строка, с которой выпоняется экспорт (включая заголовок, если есть)
'    nStartCol = 1 ' Номер столбца на листе - первый столбец , с которого выполняется экспорт
'    vCutHeader = True ' Наличие строки заголовка (подписей столбцов) и его удаление:
'       =True=-1 - заголовок считается равным 1 строке, при этом из результирующего файла заголовок исключается
'       <0 - размер заголовка в строках, исключается из результата
'       >0 - размер заголовка в строках, не исключается из результата (но записывается "как есть", без преобразований)
'       =False=0 - заголовок отсутствует
'    cFormatdateTime = "YYYY-MM-DD hh:mm:ss" ' формат даты/времени, по умолчанию выставлен в ISO8601 для совместимости
'    cTypeQualifier = "#" ' квалификатор логических значений и даты, по умолчанию - пустаое значение
          
     Dim wb As Workbook, newwb As Workbook, sh As Worksheet, newsh As Worksheet
     Dim nLastRow As Long, nLastCol As Long, i As Long, j As Long
     Dim cOut As String, cValue, cOutAll As String
      
     Application.ScreenUpdating = False
     Application.StatusBar = "Идёт экпорт..."
     Set wb = ActiveWorkbook
     Set sh = ActiveSheet
      
     cOutAll = ""
      
' Установки границ экспортируемой таблицы
' Правая-нижняя граница выставляется по используемой области листа
     nLastRow = sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1
     nLastCol = sh.UsedRange.Column + sh.UsedRange.Columns.Count - 1
' Левая-верхняя граница подтягивается к началу заполнения на листе
     nStartRow = Application.WorksheetFunction.Max(nStartRow, sh.UsedRange.Row)
     nStartCol = Application.WorksheetFunction.Max(nStartCol, sh.UsedRange.Column)
' ВНИМАНИЕ - заголовок будет отсчитан от нового левого-верхнего положения
' Анализ заголовка
     vCutHeader = vCutHeader + 0
     If vCutHeader < 0 Then nStartRow = nStartRow - vCutHeader
' Сборка данных
     For i = nStartRow To nLastRow
         vCutHeader = vCutHeader - 1
         cOut = ""
         For j = nStartCol To nLastCol
             cValue = sh.Cells(i, j)
             If vCutHeader < 0 Then ' не строка заголовка
                 Select Case VarType(cValue)
                 Case vbString
                     cValue = cTextQualifier & cValue & cTextQualifier
                 Case vbInteger, vbLong, vbByte
                     cValue = CStr(cValue)
                 Case vbSingle, vbDouble, vbCurrency, vbDecimal
                     cValue = Replace(CStr(cValue), Application.International(xlDecimalSeparator), cDecimalSeparator)
                 Case vbBoolean
                     cValue = cTypeQualifier & CStr(cValue) & cTypeQualifier
                 Case vbDate
                     cValue = cTypeQualifier & Format(cValue, cFormatDateTime) & cTypeQualifier
                 Case Else
                 ' Все значения ошибок
                     cValue = ""
                 End Select
             End If
             cOut = cOut & cDelimiter & cValue
         Next
         Application.StatusBar = "Идёт экпорт..." & Round(i * 100 / (nLastRow - nStartRow), 0) & "%"
         cOutAll = cOutAll & Mid(cOut, 2) & vbCrLf
     Next
      
' Сохранение файла
     If Len(cFileName) = 0 Then cFileName = sh.Name & ".csv"
     If InStr(1, cFileName, "\") = 0 Then cFileName = wb.Path & "\" & cFileName

' Запись строки в файл. Взято с:
' http://excelvba.ru/code/txt
      On Error Resume Next: Err.Clear
      Dim fso As Object, ts As Object
      Set fso = CreateObject("scripting.filesystemobject")
      Set ts = fso.CreateTextFile(cFileName, True)
      ts.Write cOutAll: ts.Close
      Set ts = Nothing: Set fso = Nothing
'*
     Application.StatusBar = "Готово"
     wb.Activate
     Application.ScreenUpdating = True
      
End Sub