Split data in excel to multiple sheets [Closed]

Report
-
Posts
2
Registration date
Friday May 16, 2014
Status
Member
Last seen
May 16, 2014
-
Hello,

Need help to write a macro to segregate data in one sheet to multiple sheets. I have posted a sample data below:

Name Emp ID Org. Address
A 11 R BANGALORE
B 22 R BANGALORE
C 33 F BANGALORE
D 44 F BANGALORE

Now I need your help in segregating the data into different sheets based on Col. C (Org.). For example, wherever Org. is R, it should be copied to sheet2.

Kindly let me know if you need further information.

2 replies

Posts
367
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
120
You can use following codes

Sub SplitSheets()
Dim DataSht, wsCrit, SplitSht As Worksheet
Dim lrUnq, lrData, I As Long
Dim FtrVal As String

Application.ScreenUpdating = False
Set DataSht = Worksheets("sheet1") 'change it to the name of your raw data sheet
lrData = DataSht.Range("a" & Rows.Count).End(xlUp).Row
Set wsCrit = Worksheets.Add
DataSht.Range("C1:l" & lrData).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wsCrit.Range("A1"), Unique:=True
lrUnq = wsCrit.Range("a" & Rows.Count).End(xlUp).Row
For I = 2 To lrUnq
FtrVal = wsCrit.Range("A" & i).Value
Set SplitSht = Worksheets.Add
DataSht.Select
'DataSht.ShowAllData
ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A1:Z" & lrData).AutoFilter Field:=3, Criteria1:=FtrVal
Range("a1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
SplitSht.Select
Range("A1").Select
ActiveSheet.Paste
'Cells.Select
Cells.EntireColumn.AutoFit
SplitSht.Name = FtrVal
Application.CutCopyMode = False
Next i
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
.AutoFilterMode = False
End Sub
Posts
2
Registration date
Friday May 16, 2014
Status
Member
Last seen
May 16, 2014

HI, is your query solved. I would need to know the same if it is working...

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!