Разделение листа Excel в разных файлах и копирование данных из определенных столбцов в новые файлы - PullRequest
Новая
       6

Разделение листа Excel в разных файлах и копирование данных из определенных столбцов в новые файлы

0 голосов
/ 29 октября 2018

Хорошо, у меня есть файл Excel, который заполнен числами от первой до последней строки в столбце A. Что мне нужно сделать, это разбить файл на разные файлы для каждой строки на 50 тысяч (таким образом, в основном 20 новых файлов) и скопируйте и вставьте числа так, чтобы они соответствовали порядку процесса разделения. Так что в основном первый новый файл должен иметь числа от строки 1 до строки 50000, затем второй файл должен иметь числа от строки 50000 до строки 100000 и т. д. I Удалось разделить его на 20 разных файлов, но понятия не имею, как на самом деле скопировать и вставить данные. Это то, что я имею до сих пор: 

Sub splitBook()

Dim cell As Range
Dim xPath As String
Dim i As Long, row As Long, lastRow As Long
Dim counter As Integer
Dim wb As Workbook
Dim rows As Range
counter = 0
Dim broi As Integer
broi = 20

xPath = "C:\Users\User\Documents\Test"
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each cell In Sheets("Test").Range("ColumnA")
    If i = 0 Then

                Workbooks.Add
                Set wb = ActiveWorkbook
                ThisWorkbook.Activate
    End If

            i = i + 1
            If i = 50000 Then

                counter2 = counter2 + 1
                wb.SaveAs Filename:=xPath & " file number " & CStr(counter2)
                wb.Close
                Set rows = Nothing
                i = 0

            End If
        Next cell

Set wb = Nothing
Application.DisplayAlerts = True

End Sub

1 Ответ

0 голосов
/ 29 октября 2018

Кроме того, вы можете создать основной диапазон и проходить через каждые 50 000 строк: 

Sub new_workbooks()
Dim xpath As String: xPath = "C:\Users\User\Documents\Test"
Dim groupCount As Long: groupCount = 50000
Dim counter2 As Long: counter2 = 1
Dim rng As Range, tmpRng As Range

Dim totalRows As Long, totalNewBooks As Long
totalRows = Cells(Rows.Count, 1).End(xlUp).Row

Dim i As Long
Dim newWB As Workbook
For i = 1 To totalRows Step groupCount
    Set tmpRng = Range("A" & i & ":A" & i + groupCount - 1)
    Set newWB = Workbooks.Add
    tmpRng.Copy newWB.Sheets(1).Range("A1")
    Application.CutCopyMode = False
    newWB.SaveAs Filename:=xpath & " file number " & CStr(counter2)
    newWB.Close
    counter2 = counter2 + 1
Next i

End Sub
...