Порубить помельче
Скрипт для разбивки списков на части

Часто в своей работе встречаю, что сервисы принимают определенное количество фраз для обработки. Так или иначе, ограничения есть у всех под разные инструменты. Обычно использую для таких задач скрипт в Excel. Просто и со вкусом. Скрипт создаст удобное окошко для ввода числа для нарезки, а затем аккуратно распределит данные по новым листам.

Как это работает:
✅ Вы запускаете макрос.
✅ Появляется модальное окно, где вы вводите, по сколько строк нужно «нарезать» данные.
✅ Скрипт берет данные из столбца A активного листа.
✅ Создает новые листы сразу после текущего и копирует туда блоки данных.
Исходный лист остается нетронутым.

Сам код:

Sub SplitRowsToNewSheets()
Dim wsSource As Worksheet
Dim lastRow As Long
Dim rowsPerSheet As Variant
Dim startRow As Long, endRow As Long
Dim i As Long
Dim newSheet As Worksheet
Dim sheetCounter As Integer

Set wsSource = ActiveSheet

' Находим последнюю заполненную строку в столбце A
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

' Выводим модальное окно (InputBox)
rowsPerSheet = InputBox("Введите количество строк для каждого листа:", "Разбивка строк", 100)

' Проверка: если нажали Отмена или ввели не число
If rowsPerSheet = "" Or Not IsNumeric(rowsPerSheet) Then Exit Sub
rowsPerSheet = CLng(rowsPerSheet)
If rowsPerSheet <= 0 Then Exit Sub

' Отключаем обновление экрана для скорости
Application.ScreenUpdating = False

sheetCounter = 1
startRow = 1 ' Если есть шапка, можно поставить 2

Do While startRow <= lastRow
endRow = startRow + rowsPerSheet - 1
If endRow > lastRow Then endRow = lastRow

' Создаем новый лист ПОСЛЕ текущего или после предыдущего созданного
Set newSheet = Sheets.Add(After:=Sheets(wsSource.Index + sheetCounter - 1))
newSheet.Name = "Часть " & sheetCounter

' Копируем данные
wsSource.Rows(startRow & ":" & endRow).Copy Destination:=newSheet.Range("A1")

' Переходим к следующему блоку
startRow = endRow + 1
sheetCounter = sheetCounter + 1
Loop

wsSource.Activate
Application.ScreenUpdating = True

MsgBox "Готово! Данные разбиты на " & (sheetCounter - 1) & " лист(ов).", vbInformation
End Sub

#чеклисты_списки_нс