There is a File, about 930000 lines, it is required to divide it into ~ 93 EXEL files of 10,000 lines each. Below is the script, but it does not work.

Sub Test() Dim currentRows As Long, sourceCol As Long, LastRow as Long Dim currentRowValue As String, sourcews As String, rows2 As Long Dim sheetName As String, Исходная As Excel.Workbook, Конечная As Excel.Workbook Set Исходная = ActiveWorkbook sourcews = ActiveSheet.Name sourceCol = 1 RowCoun = Cells(Rows.Count, sourceCol).End(xlUp).Row file2 = 1 МакросКнига ("C:\1\Moscow_Samara" & file2 & ".xls") Set Конечная = Workbooks.Open("C:\1\Moscow_Samara" & file2 & ".xls") For currentRow = 1 To RowCount rows2 = rows2 + 1 currentRowValue = Исходная.Cells(currentRow, sourceCol).Value If Not (IsEmpty(currentRowValue) or currentValue = "") Then Конечная.Worksheets(sheetName).Select LastRow = Cells(Конечная.Rows.Count, sourceCol).End(xlUp).Row If LastRow = 1 And rows2 = 1 Then LastRow = 0 Range(Конечная.Cells(LastRow + 1, 1), Конечная.Cells(LastRow + 1, 1)) _ .PasteSpecial Paste:=xlPasteValues Исходная.WorkSheets(sourcews).Activate End If If rows2 = 10000 Then Конечная.Close SaveChanges:=True file2 = file2 + 1 rows2 = 0 sheetName = "Финиш" & file2 МакросКнига ("C:\1\Moscow_Samara" & file2 & ".xls") Set Конечная = Workbooks.Open("C:\1\Moscow_Samara" & file2 & ".xls") End If Next End Sub Sub МакросКнига (FName As String) ActiveWorkbook.SaveAs FileName: = FName, FileFormat:= _ xlNormal, Password:="", ReadOnlyRecommended:= False _ , CreateBackup:=False EndSub
  • There is already ready code, but it does not work. I'm trying to shove it. - Arseny
  • We believe in you. :) Editing help here - Deft
  • Fuuuuuh, rewrote - Arseny
  • Easier to write new) Lines to transfer everything? All user range? Is there a table cap? Copy it to all files? What are the names of the files being created? - vikttur
  • This is it, and there are no more options for how to write. Lines are required to transfer everything. Copying should be done by the following algorithm: 10,000 copied to a separate file, creates a file where the next 10,000 lines (And so on until the end of the file should be 93-94 files) are about 20 columns. I trust in you, the all-knowing divine StackOwerflow, and pray as an enikeyshchik .... - Arseny

1 answer 1

Next to the source file, a folder is created (if there is none) into which new books are added.

 Sub SeparateRows() Dim wBook As Object Dim sFldr As String, sFName As String Dim lRw As Long, lStep As Long Dim i As Long, k As Long, n As Long ' принимаем, что данные начинаются с первой строки' lRw = ws1.UsedRange.Rows.Count ' количество строк' If lRw < lStep Then Exit Sub ' разбивать нечего' lStep = 10000 ' к-во строк в блоке' sFldr = ThisWorkbook.Path & "\" & "Разбивка" & "\" ' путь к папке для сохранения' If Dir(sFldr, vbDirectory) = "" Then MkDir sFldr ' создаем, если нет' ' ---------------------------------------------------------------------------------- With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With For i = 1 To lRw Step lStep ' циклом поблочно' With Workbooks.Add ' новая книга' ws1.Copy Before:=.Sheets(1) ' копируем лист в новую книгу' With .Sheets(1) .Name = i ' имя листа' If i > 1 Then ' удаляем лишние строки' .Rows(i + lStep & ":" & lRw + 1).Delete .Rows(1 & ":" & i - 1).Delete Else .Rows(lStep + 1 & ":" & lRw + 1).Delete End If End With For k = .Sheets.Count To 2 Step -1: .Sheets(k).Delete: Next k ' удаляем листы' If i + lStep - 1 < lRw Then sFName = "Строки_" & i & "_" & i + lStep - 1 & ".xlsx" ' имя книги' Else sFName = "Строки_" & i & "_" & lRw & ".xlsx" End If .SaveAs Filename:=sFldr & sFName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False .Close: n = n + 1 ' счетчик созданных книг' End With Next i Set wBook = Nothing With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With MsgBox "Обработка завершена" & Chr$(10) & "Создано файлов: " & n, 64, "" End Sub

The code indicates the internal name of the sheet - ws1 . It can be changed in the VBA editor. But you can replace it in the code with Worksheets ("name_list")

lStep - set the number of lines in one block

  • I had one idea here, tell me how to implement it. 'Rows (2+ (i-1) * 10000: i * 10000) .Select' swears at:. It turns out wrong. How to implement a formula in Rows? - Arseny
  • Rows (i & ":" & k) Look in the code for a similar line. Why select lines? Code work with leaf objects is slow. Any extra movement on the sheet is extra brakes. - vikttur
  • I came up with a simple solution, now Richth. - Arseny
  • My code did not fit? - vikttur
  • The solution is good, but there is an option that is easier and more convenient. I don’t know about faster until it starts up - Arseny