Split data in excel to multiple sheets

Closed
Roy - May 24, 2012 at 03:41 AM
Xcellenthu Posts 2 Registration date Friday May 16, 2014 Status Member Last seen May 16, 2014 - May 16, 2014 at 10:39 AM
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

RWomanizer Posts 365 Registration date Monday February 7, 2011 Status Contributor Last seen September 30, 2013 120
May 24, 2012 at 04:24 AM
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
0
Xcellenthu Posts 2 Registration date Friday May 16, 2014 Status Member Last seen May 16, 2014
May 16, 2014 at 10:39 AM
HI, is your query solved. I would need to know the same if it is working...
0