Excel VBA: макрос для всех листов, csv

[iva]

Добрый день!

Можете ли подсказать, что надо изменить в этом макросе (взят из интернета), чтобы он стал работать на всех листах, а не только на активном? Макрос сохраняет excel в csv.

Я попробовала активизировать каждый лист:
For Each sh In ActiveWorkbook.Worksheets
    sh.Activate
но почему-то в результате получается только два итоговых файла, а остальные листы не обрабатывает.

Вот вариант с моими изменениями, который обрабатывает только два листа:

Макрос

Sub ЭкспортПрайсЛистаВФорматеCSV()

    On Error Resume Next
    Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
    sh.Activate

    ' диапазон ячеек с A5 до последней заполненной ячейки в столбце A
    ' расширенный по горизонтали на 10 столбцов (выгружаются столбцы с A по J)
    Dim ra As Range: Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)

    ' формируем текстовую строку, содержащую текст диапазона в формате CSV
    CSVtext$ = Range2CSV(ra, ";")    ' можно указать другой разделитель столбцов

    ' создаём в папке с файлом XLS подпапку для CSV-прайсов (если такой папки ещё нет)
    CSVfolder$ = ThisWorkbook.Path & "\CSV prices\": MkDir CSVfolder$

    ' формируем имя создаваемого файла CSV (c указанием текущей даты)
    CSVfilename$ = Format(Now, "YYYY MM DD  HH-NN-SS") & ".csv"

    ' сохраняем текстовую CSV-строку CSVtext$ в файл с именем CSVfilename$
    SaveTXTfile CSVfolder$ & CSVfilename$, CSVtext$
    Next sh
End Sub

Function Range2CSV(ByRef ra As Range, Optional ByVal ColumnsSeparator$ = ";", _
                   Optional ByVal RowsSeparator$ = vbNewLine) As String
    If ra.Cells.Count = 1 Then Range2CSV = ra.Value & RowsSeparator$: Exit Function
    If ra.Areas.Count > 1 Then
        Dim ar As Range
        For Each ar In ra.Areas
            Range2CSV = Range2CSV & Range2CSV(ar, ColumnsSeparator$, RowsSeparator$)
        Next ar
        Exit Function
    End If
    arr = ra.Value

    ' иначе конкатенация длинных текстовых строк притормаживает макрос
    chr34$ = Chr(34): buffer$ = "": buffer2$ = "": Const BufferLen& = 15000
    For i = LBound(arr, 1) To UBound(arr, 1)
        txt = "": For j = LBound(arr, 2) To UBound(arr, 2)
            txt = txt & ColumnsSeparator$ & chr34$ & Replace(arr(i, j), chr34$, "'") & chr34$
        Next j

        buffer$ = buffer$ & Mid(txt, Len(ColumnsSeparator$) + 1) & RowsSeparator$

        ' для многократного увеличения производительности при больших диапазонах данных
        If Len(buffer$) > BufferLen& Then
            buffer2$ = buffer2$ & buffer$: buffer$ = ""
            If Len(buffer2$) > BufferLen& * 40 Then _
               Range2CSV = Range2CSV & buffer2$: buffer2$ = "" ': DoEvents
        End If

    Next i
    Range2CSV = Range2CSV & buffer2$ & buffer$
End Function

Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean
    On Error Resume Next: Err.Clear
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.CreateTextFile(filename, True)
    ts.Write txt: ts.Close
    SaveTXTfile = Err = 0
    Set ts = Nothing: Set fso = Nothing
End Function

[свернуть]

[Администратор]

На листе, в какой-либо ячейке может быть текст с точкой запятой?
Если может, то способ, который вы нашли в интернете, вам не подходит. В этом случае вам надо использовать другой способ - создание csv-файла с помощью экселя.

[iva]

Нет, точки с запятой нигде нет.  Только если случайная опечатка где-то вдруг возникнет.

[Администратор]

При использовании макросов, не обязательно переходить на лист, с которым надо работать. То есть этот код не всегда нужно использовать:
sh.Activate

То есть в вашем случае достаточно так:

Код

Sub ЭкспортПрайсЛистаВФорматеCSV()

    Dim sh As Worksheet
    On Error Resume Next
   
    For Each sh In ActiveWorkbook.Worksheets
   
        ' диапазон ячеек с A5 до последней заполненной ячейки в столбце A
        ' расширенный по горизонтали на 10 столбцов (выгружаются столбцы с A по J)
        Dim ra As Range: Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)
     
        ' формируем текстовую строку, содержащую текст диапазона в формате CSV
        CSVtext$ = Range2CSV(ra, ";")    ' можно указать другой разделитель столбцов
   
        ' создаём в папке с файлом XLS подпапку для CSV-прайсов (если такой папки ещё нет)
        CSVfolder$ = ThisWorkbook.Path & "\CSV prices\": MkDir CSVfolder$
     
        ' формируем имя создаваемого файла CSV (c указанием текущей даты)
        CSVfilename$ = Format(Now, "YYYY MM DD  HH-NN-SS") & ".csv"
     
        ' сохраняем текстовую CSV-строку CSVtext$ в файл с именем CSVfilename$
        SaveTXTfile CSVfolder$ & CSVfilename$, CSVtext$
       
    Next sh
   
End Sub

[свернуть]

[Администратор]

Этот код делает следующее:
Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)

Предполагается, что данные начинаются с ячейки A5. У вас данные начинаются с ячейки A5?

Затем макрос ищет в столбце A последнюю строку с данными. При использовании "End", на листе не должно быть скрытых строк, т.к. команда "End" не ищет в скрытых строках.
sh.Range("A" & sh.Rows.Count).End(xlUp))

Затем макрос расширяет диапазон до десятого столбца:
Resize(, 10)

После чего макрос работает с диапазоном:
A5:J_последняя строка в столбце A.

У вас такие же диапазоны? Макрос вы взяли в интернете, макрос специально для вашего файла не делали.

[iva]

Да, я поняла, когда смотрела макрос, что можно менять при желании ячейку-начало и количество столбцов.
Но поскольку у меня сводные, то как раз подошло, начиная с А5 и до конца столбца. Правда появляются в конце слова "Общий итог", ненужные, но мне это некритично.
И количество столбцов я пока не меняла, т.к. еще не знаю точно, сколько их надо будет. Вероятно около 7.

Про скрытые строки не знала. У меня их здесь нет, но буду знать.

[Администратор]

Запустите этот макрос. После работы макроса отобразите окно View - Immediate Window.
Подсчитайте, сколько фрагментов эксель-листа в окне "Immediate Window" и посмотрите адреса фрагментов эксель-листа в окне "Immediate Window". Затем посмотрите свои листы и сравните. Всё ли нормально?

Код

Sub ЭкспортПрайсЛистаВФорматеCSV()

    Dim sh As Worksheet
    On Error Resume Next
   
    For Each sh In ActiveWorkbook.Worksheets
   
        ' диапазон ячеек с A5 до последней заполненной ячейки в столбце A
        ' расширенный по горизонтали на 10 столбцов (выгружаются столбцы с A по J)
        Dim ra As Range: Set ra = sh.Range(sh.[A5], sh.Range("A" & sh.Rows.Count).End(xlUp)).Resize(, 10)
     
        Debug.Print ra.Address
     
        ' формируем текстовую строку, содержащую текст диапазона в формате CSV
        CSVtext$ = Range2CSV(ra, ";")    ' можно указать другой разделитель столбцов
   
        ' создаём в папке с файлом XLS подпапку для CSV-прайсов (если такой папки ещё нет)
        CSVfolder$ = ThisWorkbook.Path & "\CSV prices\": MkDir CSVfolder$
     
        ' формируем имя создаваемого файла CSV (c указанием текущей даты)
        CSVfilename$ = Format(Now, "YYYY MM DD  HH-NN-SS") & ".csv"
     
        ' сохраняем текстовую CSV-строку CSVtext$ в файл с именем CSVfilename$
        SaveTXTfile CSVfolder$ & CSVfilename$, CSVtext$
       
    Next sh
   
End Sub

[свернуть]

[iva]

С фрагментами все в порядке.

[Администратор]

Сюда подставьте имя листа, из которого извлекаются данные (вы это хотели сделать):
        ' формируем имя создаваемого файла CSV (c указанием текущей даты)
        CSVfilename$ = Format(Now, "YYYY MM DD  HH-NN-SS") & ".csv"

У вас указано время, какие-то листы возможно моментально обрабатываются (в течение секунды) и у них совпадает время.

[iva]

CSVfilename$ = ActiveSheet.name & ".csv"

Так?

[Администратор]

ActiveSheet - это лист, который отображается на мониторе.

В вашем случае вы перемещаетесь по листам таким способом:
For Each sh In ActiveWorkbook.Worksheets

Значит вам надо использовать переменную "sh". Переменная "sh" - это и есть лист. Печатаете в коде "sh" ставите точку и выбираете нужный член.

[Администратор]

Сюда подставьте имя листа, из которого извлекаются данные (вы это хотели сделать):
        ' формируем имя создаваемого файла CSV (c указанием текущей даты)
        CSVfilename$ = Format(Now, "YYYY MM DD  HH-NN-SS") & ".csv"

У вас указано время и какие-то листы возможно моментально обрабатываются (несколько листов обрабатывается в течение одной секунды) и у них совпадает время.

[iva]

Сделала:
CSVfilename$ = sh.name & ".csv"

Работает! Все листы обработаны, и файлы называются как листы.
Спасибо!