CODEWITHSUNDEEP
excelvbasplit
Kaloyan
Kaloyan

Reputation: 3

Split Excel Worksheet in Different Files and Copy Data from Specific Columns to the new files

Alright so I have an excel file that's filled up with numbers from the first to the last row in column A.What i need to do is split the file into different files for every 50th thousand row (so basically 20 new files) and copy paste the numbers so they correspond to the order of the splitting process.So basically the first new file should have the numbers from row 1 to row 50000 then the second file should have the numbers from row 50000 to row 100000 and etc.I've managed to split it into 20 different files but have no idea at how to actually copy-paste the data. This is what i have so far:

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

Upvotes: 0

Views: 256

Answers (1)

BruceWayne
BruceWayne

Reputation: 23283

Alternatively, you could create a master range, and step through every 50,000 rows:

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

Upvotes: 1

Related Questions