Разделить файл на несколько

[gred]

Есть экселевский файл , в нём 102 тысячи записей. Надо разделить файл на несколько файлов по 70 записей.
Есть идеи?
Буду очень благодарен.

[IgorGO]

в итоге получится полторы тысячи файлов. как их назвать, куда складывать?

[аналитика]

если ровно 102 000 записей, то 1 458 книг будет создано (в той же папке, где и исходная книга)

Sub Seventy()
   Dim lr As Long
   Dim i As Integer

   lr = Cells(Rows.Count, 1).End(xlUp).Row

   Do
      i = i + 1
      If 70 * (i - 1) + 1 > lr Then Exit Sub

      Range("A" & 70 * (i - 1) + 1 & ":A" & 70 * i).Copy 'здесь вторую "А" заменишь на букву последнего используемого столбца
      Workbooks.Add
      ActiveSheet.Paste
      ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Книга" & i & ".xls", _
                            FileFormat:=xlExcel8
      ActiveWorkbook.Close
   Loop
End Sub

[SAS888]

А Вам это действительно нужно? Может быть сделать скрипт, который по запросу будет создавать один требуемый файл?

[gred]

Спс за ответы.

Сообщение от аналитика

если ровно 102 000 записей, то 1 458 книг будет создано (в той же папке, где и исходная книга)

Sub Seventy()
   Dim lr As Long
   Dim i As Integer

   lr = Cells(Rows.Count, 1).End(xlUp).Row

   Do
      i = i + 1
      If 70 * (i - 1) + 1 > lr Then Exit Sub

      Range("A" & 70 * (i - 1) + 1 & ":A" & 70 * i).Copy 'здесь вторую "А" заменишь на букву последнего используемого столбца
      Workbooks.Add
      ActiveSheet.Paste
      ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Книга" & i & ".xls", _
                            FileFormat:=xlExcel8
      ActiveWorkbook.Close
   Loop
End Sub

А не будет комп зависать от этого?
lr = Cells(Rows.Count, 1).End(xlUp).Row - можешь рассказать что тут делается остальное более менее понятно.
И последний вопрос ты что подразумеваешь под "книгой"? И я забыл сказать что эти файлы надо сохранять в csv

А Вам это действительно нужно? Может быть сделать скрипт, который по запросу будет создавать один требуемый файл?

Да нужен и такой если не трудно напишете. Я в вба не очень разбираюсь, но тут понадобилось.
Ещё раз выражаю очееень большую благодарность кто помогает.

[EducatedFool]

И я забыл сказать что эти файлы надо сохранять в csv
Да нужен и такой если не трудно напишете

Да написаны давно подобные макросы...
Вы искать пробовали?

А если не пробовали, то, может, хоть правила раздела прочитаете?
(насчёт примера файла)

Если бы вы сразу сказали про CSV, и прикрепили к сообщению примеры файлов Excel и CSV (то, что есть, и то, что надо получить), - уже получили бы готовый макрос.

(добавлено)
Если данных было бы немного - помог бы этот макрос:

Option Compare Text
Const СтолбцыСТегами = "2,3,4,5,6,7,8,9,10,11"
Public Const CSVseparator = ";"

Sub Export2CSV()
    Dim sh As Worksheet: Set sh = Worksheets("For Tags Export")
    Dim cell As Range, ra As Range ' : Application.ScreenUpdating = False
    Set ra = sh.Range(sh.[A1], sh.Range("A" & sh.Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        If cell = "есть" Then txt = txt & ТекстСтроки(cell.EntireRow)
    Next cell
    CSVpath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "Levis_Tags_" & Format(Now, "DD.MM.YY_HH.NN") & ".csv")
    SaveTXTfile CSVpath, txt
    MsgBox "CSV-файл для загрузки тегов в интернет-магазин успешно создан: " & CSVpath, vbInformation, "Готово"
End Sub

Function ТекстСтроки(ByRef ra As Range) As String
    For Each col In Split(СтолбцыСТегами, ",")
        ТекстСтроки = ТекстСтроки & CSVseparator & ra.Cells(col).Text
    Next
    ТекстСтроки = Mid(ТекстСтроки, Len(CSVseparator) + 1) & vbNewLine
End Function

В вашем же случае надо использовать специальную функцию:

Function Range2CSVstring(ByRef ra As Range, Optional ByVal sep As String = ";") As String
    ' получает диапазон ra и разделитель данных в файле CSV (по умолчанию разделитель ";")
    ' возвращает текстовую строку - готовую для записи в файл CSV
    Dim ro As Range, a
    For Each ro In ra.Rows
        a = ro.Value
        If IsArray(a) Then
            Range2CSVstring = Range2CSVstring & Arr2CSVstring(a, 1, LBound(a, 2), UBound(a, 2), sep) & vbNewLine
        Else
            Range2CSVstring = Range2CSVstring & a & vbNewLine
        End If
    Next ro
End Function