=ЕСЛИОШИБКА(
ВПР([@ID];static_prices;10;0);
ЕСЛИ(И(ABS(ДЕНЬНЕД(ТДАТА();2)+ОСТАТ(ОКРУГЛ(ТДАТА();4);1)-6,625)<=1;[@Поставщик]<>"Pavilion");0;[@Остаток]))

Sub ExportToCSVUTF8()
    Dim ws As Worksheet, nws As Worksheet
    Dim wb          As Workbook
    Dim delim$, Path$, txt$
    Dim i&, j&, s&
    Dim arr(), arr2()
 
    Set ws = ActiveWorkbook.Worksheets("Итоговые цены")
    arr = ws.UsedRange.Value
    delim = "|": s = 3000
 
    For i = LBound(arr, 1) To UBound(arr, 1)
        ReDim Preserve arr2(i - 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            If txt = "" Then
                txt = arr(i, j)
            Else
                txt = txt & delim & arr(i, j)
            End If
        Next j
        arr2(i - 1) = txt
        txt = ""
    Next i
     
    For i = LBound(arr2) To UBound(arr2) Step s
        Set wb = Workbooks.Add
        For j = i To i + (s - 1)
            If j > UBound(arr2) Then Exit For
            wb.Worksheets(1).Cells(j - i + 1, 1).Value = arr2(j)
        Next j
        Application.DisplayAlerts = False
        wb.SaveAs "d:\Clouds\Yandex.Disk\Магазин\pricelists\import\" & "Prices_marketplaces_from_" & i & "_to_" & i + s & ".csv", xlCSVUTF8
        wb.Close False
    Next i
    'MsgBox "Готово", vbInformation, "PlanetaExcel"
End Sub

Sub ExportToCSV_UTF8()
    'CSV в кодировке UTF8+BOM
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sSymbol As String, txt As String
    Dim i As Long, j As Long, RowsLimit As Long
    Dim arr(), arr2()
 
    If MsgBox("Сохранить лист в CSV?", vbQuestion + vbYesNo, "Вопросы") = vbNo Then Exit Sub
    
    sSymbol = "|" 'символ-разделитель
    RowsLimit = 3000 'кол-строк строк в 1 файле
           
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    
    Set ws = ActiveWorkbook.Worksheets("Итоговые цены")
    arr = ws.UsedRange.Value
 
    For i = LBound(arr, 1) To UBound(arr, 1)
        ReDim Preserve arr2(i - 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            If txt = "" Then
                txt = arr(i, j)
            Else
                txt = txt & sSymbol & arr(i, j)
            End If
        Next j
        arr2(i - 1) = Replace$(txt, Chr(34), "")
        txt = ""
    Next i
     
    For i = LBound(arr2) To UBound(arr2) Step RowsLimit
        Set wb = Workbooks.Add
        For j = i To i + (RowsLimit - 1)
            If j > UBound(arr2) Then Exit For
            wb.Worksheets(1).Cells(j - i + 1, 1).Value = arr2(j)
        Next j
        wb.SaveAs "d:\Clouds\Yandex.Disk\Магазин\pricelists\import\" & "Prices_marketplaces_from_" & i & "_to_" & i + RowsLimit & ".csv", xlCSVUTF8
        wb.Close False
    Next i
    
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Готово", vbInformation, "Конец"
End Sub

Sub enstaralfgh()
Dim Arr1, nRow&, nSt&, kRow&, RowP&, Put1$, ImaF$, Str1$, Rz$, i&, j&, DF2 As Byte
    Put1 = ThisWorkbook.Path & "\"
    kRow = 3000: Rz = "|"
    Arr1 = ActiveSheet.UsedRange.Value
    nRow = UBound(Arr1, 1)
    nSt = UBound(Arr1, 2)
    RowP = kRow
ImaF = Put1 & "1" & "_to_" & RowP & ".csv"
If Dir(ImaF, 7) <> vbNullString Then Kill ImaF
DF2 = FreeFile: Open ImaF For Binary As #DF2
    For i = 1 To nRow
        For j = 1 To nSt
'Str1 = CStr(Arr1(i, j))
Str1 = EncodeUTF8noBOM(CStr(Arr1(i, j)))
If j <> nSt Then Put #DF2, , Str1 & Rz Else Put #DF2, , Str1 & vbNewLine
        Next j
            If i = RowP Then
            Close #DF2
If RowP + kRow < nRow Then RowP = RowP + kRow Else kRow = nRow - RowP: RowP = nRow
ImaF = Put1 & RowP - kRow & "_to_" & RowP & ".csv"
If Dir(ImaF, 7) <> vbNullString Then Kill ImaF
If i <> nRow Then DF2 = FreeFile: Open ImaF For Binary As #DF2
            End If
    Next i
End Sub

Close

Reset

Sub ExportToCSV_UTF8()
    Dim arrData As Variant
    Dim sPath As String, sSymbol As String, sFileName As String, sStr As String
    Dim QtyOfRows As Long, QtyOfCols As Long, LimitRows As Long, RowsCounter As Long, i As Long, j As Long
    
    sPath = ThisWorkbook.Path & "\"
    LimitRows = 3000 'ActiveSheet.Rows.Count
    sSymbol = "|"
    
    arrData = ActiveSheet.UsedRange.Value
    QtyOfRows = UBound(arrData, 1)
    QtyOfCols = UBound(arrData, 2)
    RowsCounter = LimitRows
    
    If QtyOfRows >= LimitRows Then
        sFileName = "1" & "_to_" & RowsCounter & ".csv"
    Else
        sFileName = "1" & "_to_" & QtyOfRows & ".csv"
    End If
    
    With CreateObject("ADODB.Stream")
        .Open
        .Charset = "UTF-8"
        For i = 1 To QtyOfRows
            For j = 1 To QtyOfCols
                sStr = CStr(arrData(i, j))
                If j <> QtyOfCols Then
                    .WriteText sStr & sSymbol
                Else
                    If i Mod LimitRows = 0 Or i = QtyOfRows Then
                        .WriteText sStr 'последняя строка в файле: не добавляем vbNewLine
                    Else
                        .WriteText sStr & vbNewLine
                    End If
                End If
            Next j
            If i = RowsCounter Or i = QtyOfRows Then 'сохранить файл, если достигли конца массива
                .SaveToFile sFileName, 2
                .Close
                If RowsCounter + LimitRows < QtyOfRows Then
                    RowsCounter = RowsCounter + LimitRows
                Else
                    LimitRows = QtyOfRows - RowsCounter
                    RowsCounter = QtyOfRows
                End If
                sFileName = RowsCounter - LimitRows + 1 & "_to_" & RowsCounter & ".csv"
                If i <> QtyOfRows Then .Open
            End If
        Next i
    End With
    
    MsgBox "Файлы сохранены в папку: " & sPath, vbInformation, "CSV"
End Sub