Do you have a big data on excel sheet and you need to distribute that sheet in multiple sheets, based on some data in a column? This very basic task but time consuming.
For example, I have this data. This data has a column named Date, Writer and Title. Writer column has name of writer of respective title. I want to get each writer’s data in separate sheets.
To do this manually, I have to do the following:
In this example, I have only three names. Imagine if have 100s of names. How would you split data into different sheets? It will take a lot of time and it will drain you too.
To Automate above process of splitting sheet into multiple sheets, follow these steps.
Sub SplitIntoSheets() With Application .ScreenUpdating = False .DisplayAlerts = False End With ThisWorkbook.Activate Sheet1.Activate 'clearing filter if any On Error Resume Next Sheet1.ShowAllData On Error GoTo 0 Dim lsrClm As Long Dim lstRow As Long 'counting last used row lstRow = Cells(Rows.Count, 1).End(xlUp).Row Dim uniques As Range Dim clm As String, clmNo As Long On Error GoTo handler clm = Application.InputBox("From which column you want create files" & vbCrLf & "E.g. A,B,C,AB,ZA etc.") clmNo = Range(clm & "1").Column Set uniques = Range(clm & "2:" & clm & lstRow) 'Calling Remove Duplicates to Get Unique Names Set uniques = RemoveDuplicates(uniques) Call CreateSheets(uniques, clmNo) With Application .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With Sheet1.Activate MsgBox "Well Done!" Exit Sub Data.ShowAllData handler: With Application .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With End Sub Function RemoveDuplicates(uniques As Range) As Range ThisWorkbook.Activate Sheets.Add On Error Resume Next ActiveSheet.Name = "uniques" Sheets("uniques").Activate On Error GoTo 0 uniques.Copy Cells(2, 1).Activate ActiveCell.PasteSpecial xlPasteValues Range("A1").Value = "uniques" Dim lstRow As Long lstRow = Cells(Rows.Count, 1).End(xlUp).Row Range("A2:A" & lstRow).Select ActiveSheet.Range(Selection.Address).RemoveDuplicates Columns:=1, Header:=xlNo lstRow = Cells(Rows.Count, 1).End(xlUp).Row Set RemoveDuplicates = Range("A2:A" & lstRow) End Function Sub CreateSheets(uniques As Range, clmNo As Long) Dim lstClm As Long Dim lstRow As Long For Each unique In uniques Sheet1.Activate lstRow = Cells(Rows.Count, 1).End(xlUp).Row lstClm = Cells(1, Columns.Count).End(xlToLeft).Column Dim dataSet As Range Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm)) dataSet.AutoFilter field:=clmNo, Criteria1:=unique.Value lstRow = Cells(Rows.Count, 1).End(xlUp).Row lstClm = Cells(1, Columns.Count).End(xlToLeft).Column Debug.Print lstRow; lstClm Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm)) dataSet.Copy Sheets.Add ActiveSheet.Name = unique.Value2 ActiveCell.PasteSpecial xlPasteAll Next unique End Sub
When you’ll run SplitIntoSheets() procedure, the sheet will be divided into multiple sheets, based on given column. You can add button on sheet and assign this macro to it.
How It Works
The above code has two procedures and one function. Two procedures are SplitIntoSheets(), CreateSheets(uniques As Range, clmNo As Long) and one function is RemoveDuplicates(uniques As Range) As Range.
First Procedure is SplitIntoSheets(). This is the main procedure. This procedure sets the variables and RemoveDuplicates to get unique names from given column and then passes those names to CreateSheets for creating sheets.
RemoveDuplicates takes one argument that is range which contains name. Removes duplicates from them and returns a range object that contains unique names.
Now CreateSheets is called. It takes two arguments. First the unique names and second the column no. from which we it will fitler data. Now CreateSheets takes each name from uniques and filters the given column number by each name. Copies the filtered data, adds a sheet and paste the data there. And your data is split into different sheet in seconds.
You can download the file here.
Split Into Sheets
How to use the file:
I hope article about splitting data into separate sheets was helpful for you. If you have any doubts about this or about any other feature of excel, feel free to ask it in comments section below.
The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.