Макрос автоматического сохранения csv из экселя
Есть файл состоящий из одного листа 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