разбивка файла на несколько файлов с учетом имени ячейки

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » разбивка файла на несколько файлов с учетом имени ячейки (Макросы/Sub)

exceler

Дата: Четверг, 04.05.2017, 11:48 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Добрый день! нашла на этом форуме замечательной код с разбивкой по фиксированному количеству строк. Мне необходимо было подкорректировать его, чтобы он не делил без шапки со словом HDR т.е. каждый новый файл должен был начинаться со слова HDR. Но данный код делает только 4 файла, а дальше не работает. Всего строк 10000, необходимо разбить на строки 600-700.

[vba]

Код

Sub razbivka()
Dim ROWS_IN_PART As Integer
ROWS_IN_PART = 600
Dim i&, j&, q&, ws As Worksheet, nm$
i = 1
Set ws = ActiveSheet
nm = Left(ActiveWorkbook.FullName, _
InStrRev(ActiveWorkbook.FullName, ".") - 1) & "_"
Application.ScreenUpdating = False
For q = 1 To ActiveSheet.UsedRange.Rows.Count Step 600
If Cells(i + ROWS_IN_PART, 1).Value = "HDR" Then
With Workbooks.Add(xlWBATWorksheet)
Range(ws.Rows(i), ws.Rows(i + ROWS_IN_PART - 1)).Copy ActiveCell
j = j + 1
.Close True, nm & Format(j, "000")
i = i + ROWS_IN_PART
End With
Else
ROWS_IN_PART = ROWS_IN_PART + 1
End If
Next
Application.ScreenUpdating = True
End Sub

[/vba]