Introduction to Excel VBA - Module 13 (Automatically Split Rows into Different Workbooks)

In this video, I show you how to split your data into different workbooks based on the values of the column.

Kieng Iv/SAF Business Analytics

[easunda]

great work SAF Business Analytics. Actually this lesson has helped me sort over 40, 000 rows of data in excel for credit recovery report for deliquent loans. the report was to look at deliquency per product and per employer or company from where several employees have taken credit.

I even visited your linkedin profile and made you a connection.

Thanks again

[jenb]

Thank you! Thank you! I had a spreadsheet of 41000 lines that I needed to break into 1000 spreadsheets. This was awesome!

[rajfrancis]

Thank you very much bro. You helped me a lot, I was scractching my head to do this job but you made it very simple. Thank you again 😂😂😂

[tyonci]

Terrific video, thank you! How do you maintain the original formatting in the newly created sheets?

[javusfree]

Thanks for your code, the instruction is very clear. Appreciate it!

[abdulmunnaf]

Thanks For Video. How can we populate each file to outlook as separate email, while data is spliting.

[VinodKRamachandra]

Great explanation. It really helped me.

[nileshkIndia]

Thnx for showing how to split the data into multiple workbooks.
Like you make workbooks as per division, suppose if I need to send this workbook to each divisional supervisor via outlook then what will be code & same for Gmail.

[anwarhussain]

Hi, Thanks for the excellent step by step explanation. Do the VBA code is saved anywhere, I need to use it.   Thanks in advance.

[jibinscaria]

Thank you for the lesson. Loved it! If the name of the file that we save has a special character, it will not be saved. If we remove the special character we will not be able to filter. Here in the code we have given the file name as vFilter, but i want everything to be the same and only the file name in a format that we can save i.e ( does not include special characters).How can i do that? i removed all the special characters and pasted the names in coulmn B, but unable to use two loops. please help!

[kennadimpho]

how do you make sure you keep the first row accross sheets? the headings"

[sumitbansal]

Hi, i love your video. Just need small help. I need one more workbook to be added automatically to all the sheets. Is that possible. Actually that workbook contain pivot related to the data that got split. PLease help

[amg]

Is it possible to split into multiple tabs within the same workbook, based on a range of numerical values in one column?
Example: All rows with values between to in Column D, split to a new sheet, and rename this new tab __SPLA___.
All rows with values between to in Column D, split to a new sheet, and rename this new tab __SPLB___.
All rows with values between to in Column D, split to a new sheet, and rename this new tab __SPLC___.

..so on and so forth.

[chinmayapradhan]

can you suggest how we can separate the data in the same workbook with multiple sheets

[jammy]

+SAF Business Analytics - Hi, I am hoping you receive this message.  First, thank you so much for posting this it's wonderful I was able to execute it without issues.  I just have one minor set back that I am hoping you could help me with.  Instead of the information pasting into the code you wrote "Sheets.Add" then "ActiveSheet.Name = "_Summary" " is it possible for me to paste it into a preformatted template instead? If so, what would the coding be for that? Any help would be greatly appreciated! Regards, Jamilka

[subhashiniverma]

Hi,
This code is not working for columns which contains number. Please help

[eviefong]

Hi not too sure are you still answering ques here? have some ques in mind, thanks

[brtlonghorn]

Hopefully you are still around, but my macro keeps failing at the AutoFilter section. I'm getting the "AutoFilter method of Range class failed" Run-Time Error '1004': No clue what's going on here, I was hoping you could elaborate on what that particular line is doing and if you had any thoughts on what might be failing for me.

[tiktik]

Can u help me with error 1004 in the below


Sub Split()

Dim WSWB As String
Dim WSSH As String

WSWB = ActiveWorkbook.Name
WSSH = ActiveSheet.Name

vColumn = InputBox("Enter Column Name, Split By..", "Column Selection")
Columns(vColumn).Copy
Sheets.Add
ActiveSheet.Name = "Summary"
Range("A1").PasteSpecial
Columns("A").RemoveDuplicates Columns:=1, hedder:=xlYes
vCounter = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To vCounter
vFilter = Sheets("Summary").Cells(1, 1)
Sheets(WSSH).Active
field:=Columns(vColumn).Column, criterial:=vFilter
Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial
If vFilter <> "" Then
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Split Result\" & vFilter
Else
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Split Result\Empty"
End If
ActiveWorkbook.Close
Workbooks(WSWB).Active

Next i
Sheets("Summary").Delete

End Sub

[seasonina]

Hello Friend,

I use the code below to separate and create other Workbooks, I use to do the following: I choose the column with a person's name, line 2 and ready, I have a workbooks for each column name I chose.
But what I need is for the code to parse two sheets at the same time, and then do that split. Each new workbooks should have two sheets with information relating to a person's name. For example on sheet 1 and 2 I will have the same people, but with different information. I need a workbooks for each of these people, but with the two tabs.

Can you help me by modifying the code below so I can get this result?

I'd be very happy! ;)


Public Sub SplitToFiles()

' MACRO SplitToFiles
' Last update: 2012-03-04
' Author: mtone
' Version 1.1
' Description:
' Loops through a specified column, and split each distinct values into a separate file by making a copy and deleting rows below and above
'
' Note: Values in the column should be unique or sorted.
'
' The following cells are ignored when delimiting sections:
' - blank cells, or containing spaces only
' - same value repeated
' - cells containing "total"
'
' Files are saved in a "Split" subfolder from the location of the source workbook, and named after the section name.

Dim osh As Worksheet ' Original sheet
Dim iRow As Long ' Cursors
Dim iCol As Long
Dim iFirstRow As Long ' Constant
Dim iTotalRows As Long ' Constant
Dim iStartRow As Long ' Section delimiters
Dim iStopRow As Long
Dim sSectionName As String ' Section name (and filename)
Dim rCell As Range ' current cell
Dim owb As Workbook ' Original workbook
Dim sFilePath As String ' Constant
Dim iCount As Integer ' # of documents created

iCol = Application.InputBox("Enter the column number used for splitting", "Select column", 2, , , , , 1)
iRow = Application.InputBox("Enter the starting row number (to skip header)", "Select row", 5, , , , , 1)
iFirstRow = iRow

Set osh = Application.ActiveSheet
Set owb = Application.ActiveWorkbook
iTotalRows = osh.UsedRange.Rows.Count
sFilePath =

If Dir(sFilePath + "\Split", vbDirectory) = "" Then
MkDir sFilePath + "\Split"
End If

'Turn Off Screen Updating Events
Application.EnableEvents = False
Application.ScreenUpdating = False

Do
' Get cell at cursor
Set rCell = osh.Cells(iRow, iCol)
sCell = Replace(rCell.Text, " ", "")

If sCell = "" Or (rCell.Text = sSectionName And iStartRow <> 0) Or InStr(1, rCell.Text, "total", vbTextCompare) <> 0 Then
' Skip condition met
Else
' Found new section
If iStartRow = 0 Then
' StartRow delimiter not set, meaning beginning a new section
sSectionName = rCell.Text
iStartRow = iRow
Else
' StartRow delimiter set, meaning we reached the end of a section
iStopRow = iRow - 1

' Pass variables to a separate sub to create and save the new worksheet
CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat
iCount = iCount + 1

' Reset section delimiters
iStartRow = 0
iStopRow = 0

' Ready to continue loop
iRow = iRow - 1
End If
End If

' Continue until last row is reached
If iRow < iTotalRows Then
iRow = iRow + 1
Else
' Finished. Save the last section
iStopRow = iRow
CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat
iCount = iCount + 1

' Exit
Exit Do
End If
Loop

'Turn On Screen Updating Events
Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox Str(iCount) + " documents saved in " + sFilePath


End Sub

Public Sub DeleteRows(targetSheet As Worksheet, RowFrom As Long, RowTo As Long)

Dim rngRange As Range
Set rngRange = Range(targetSheet.Cells(RowFrom, 1), targetSheet.Cells(RowTo, 1)).EntireRow
rngRange.Select
rngRange.Delete

End Sub


Public Sub CopySheet(osh As Worksheet, iFirstRow As Long, iStartRow As Long, iStopRow As Long, iTotalRows As Long, sFilePath As String, sSectionName As String, fileFormat As XlFileFormat)
Dim ash As Worksheet ' Copied sheet
Dim awb As Workbook ' New workbook

' Copy book
osh.Copy
Set ash = Application.ActiveSheet

' Delete Rows after section
If iTotalRows > iStopRow Then
DeleteRows ash, iStopRow + 1, iTotalRows
End If

' Delete Rows before section
If iStartRow > iFirstRow Then
DeleteRows ash, iFirstRow, iStartRow - 1
End If

' Select left-topmost cell
ash.Cells(1, 1).Select

' Clean up a few characters to prevent invalid filename
sSectionName = Replace(sSectionName, "/", " ")
sSectionName = Replace(sSectionName, "\", " ")
sSectionName = Replace(sSectionName, ":", " ")
sSectionName = Replace(sSectionName, "=", " ")
sSectionName = Replace(sSectionName, "*", " ")
sSectionName = Replace(sSectionName, ".", " ")
sSectionName = Replace(sSectionName, "?", " ")

' Save in same format as original workbook
ash.SaveAs sFilePath + "\Split\" + sSectionName, fileFormat

' Close
Set awb = ash.Parent
awb.Close SaveChanges:=False
End Sub