Макрос автоматического сохранения csv из экселя

Wed, 06 Dec 2023 21:26:06 +0300

Есть файл состоящий из одного листа ID, нужно автоматически разделить количество строк по 10 и сохранить каждый диапазон в csv файл

Cтолбец с ID, которые нужно сохранить в отдельные файлы

Делаем через макросы Разработчик — Visual basic.

Если вкладки «Разработчик» нет, ее нужно включить через настройки: Параметры — Настроить ленту — Разработчик.

Sub SplitAndSave()
    Dim SourceSheet As Worksheet
    Dim NewSheet As Worksheet
    Dim LastRow As Long
    Dim Group As Long
    Dim CurrentRow As Long
    Dim Path As String
    Dim DateTimeStr As String

    ' Укажите имя вашего исходного листа
    Set SourceSheet = ThisWorkbook.Sheets("Лист1")

    ' Укажите путь для сохранения файлов
    Path = "E:\work\csv\"

    ' Определите последнюю строку в столбце A
    LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

    ' Инциализируем переменные
    CurrentRow = 2 ' Начинаем с 2, так как, вероятно, у вас есть заголовок
    Group = 1

    Do While CurrentRow <= LastRow
        ' Создаем новый лист для текущей группы
        Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))
        NewSheet.Name = "Group" & Group

      ' Копируем данные текущей группы на новый лист
        SourceSheet.Rows(CurrentRow & ":" & IIf(CurrentRow + 9 <= LastRow, CurrentRow + 9, LastRow)).Copy Destination:=NewSheet.Rows(1)
        
        ' Создаем переменную с текущей датой в формате год-месяц-день-часы-минуты
        DateTimeStr = Format(Now, "yyyy-mm-dd-hh-nn")
        
    ' Сохраняем новый лист в виде CSV файла с меткой времени
        NewSheet.SaveAs Path & DateTimeStr & "_" & "Group" & Group & ".csv", xlCSV

     ' Удаляем новый лист, если необходимо
        Application.DisplayAlerts = False
        NewSheet.Delete
        Application.DisplayAlerts = True

        ' Переходим к следующей группе
        CurrentRow = CurrentRow + 10
        Group = Group + 1
    Loop
End Sub

В папку csv загрузились разделенные файлы

Добавим разбиение с сохранением заголовка из ячейки A1.
Разбивать будем по RowsPerGroup равном 1400 значений

Sub SplitAndSaveWithHeaderVariable()
    Dim SourceSheet As Worksheet
    Dim NewSheet As Worksheet
    Dim LastRow As Long
    Dim Group As Long
    Dim CurrentRow As Long
    Dim Path As String
    Dim DateTimeStr As String
    Dim HeaderVariable As String
    Dim RowsPerGroup As Long

    ' Укажите имя вашего исходного листа
    Set SourceSheet = ThisWorkbook.Sheets("Лист1")

    ' Укажите путь для сохранения файлов
    Path = "E:\work\csv\"

   ' Определите последнюю строку в столбце A
    LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

    ' Инициализируйте переменные
    CurrentRow = 2 ' Начинаем с 2, предполагая, что у вас есть заголовок
    Group = 1

    ' Установите значение переменной заголовка из ячейки A1
    HeaderVariable = SourceSheet.Cells(1, 1).Value

    ' Установите количество строк в группе
    RowsPerGroup = 1400

    Do While CurrentRow <= LastRow
       ' Создаем новый лист для текущей группы
        Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))
        NewSheet.Name = "Group" & Group

       ' Вставляем переменную заголовка в первую ячейку нового листа
        NewSheet.Cells(1, 1).Value = HeaderVariable

        ' Копируем данные текущей группы на новый лист
        SourceSheet.Rows(CurrentRow & ":" & IIf(CurrentRow + RowsPerGroup - 1 <= LastRow, CurrentRow + RowsPerGroup - 1, LastRow)).Copy Destination:=NewSheet.Rows(2)

       ' Получаем текущую дату и время в указанном формате
        DateTimeStr = Format(Now, "yyyy-mm-dd-hh-nn")

       ' Сохраняем новый лист в виде файла CSV с датой и временем в имени файла
        NewSheet.SaveAs Path & DateTimeStr & "_" & "Group" & Group & ".csv", xlCSV

        ' Удаляем новый лист, если необходимо
        Application.DisplayAlerts = False
        NewSheet.Delete
        Application.DisplayAlerts = True

       ' Переходим к следующей группе
        CurrentRow = CurrentRow + RowsPerGroup
        Group = Group + 1
    Loop
End Sub

Заметки — Игорь К.: заметки с тегом макрос

Макрос автоматического сохранения csv из экселя