Добрый вечер!Можете мне подсказать, как разделить файл Excel(Прайс-лист)на несколько файлов?К примеру : есть файл Excel на 1000 строк, мне нужно 4 файла Excel по 250 строк. Я не могу просто копировать и создавать файлы- это очень долго, у меня прайсы по 600000 строк, их надо делить на много частей, и он не один.Если Вам не сложно, можете ответить? Если я не правильно создал тему, простите.Я первый раз на этом сайте создаю тему.
Добрый вечер!Можете мне подсказать, как разделить файл Excel(Прайс-лист)на несколько файлов?К примеру : есть файл Excel на 1000 строк, мне нужно 4 файла Excel по 250 строк. Я не могу просто копировать и создавать файлы- это очень долго, у меня прайсы по 600000 строк, их надо делить на много частей, и он не один.Если Вам не сложно, можете ответить? Если я не правильно создал тему, простите.Я первый раз на этом сайте создаю тему.Stepan096
Сообщение отредактировал Stepan096 - Среда, 20.11.2013, 00:23
дааааа!!!! я нашел)если кому надо, вот макрос) Const ROWS_IN_PART = 500 'число строк в части файла [vba]
Код
Sub николай100() Dim i&, j&, ws As Worksheet, nm$ Set ws = ActiveSheet nm = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".") - 1) & "_" Application.ScreenUpdating = False For i = 1 To ActiveSheet.UsedRange.Rows.Count Step ROWS_IN_PART 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") End With Next Application.ScreenUpdating = True End Sub
[/vba]
дааааа!!!! я нашел)если кому надо, вот макрос) Const ROWS_IN_PART = 500 'число строк в части файла [vba]
Код
Sub николай100() Dim i&, j&, ws As Worksheet, nm$ Set ws = ActiveSheet nm = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".") - 1) & "_" Application.ScreenUpdating = False For i = 1 To ActiveSheet.UsedRange.Rows.Count Step ROWS_IN_PART 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") End With Next Application.ScreenUpdating = True End Sub