Hi All,

I have a Sheet with this kind of data:

ColumnA ColumnB Column C
Pam tree a asdf
Tom low b adf
Sam bree c adf
Pam tree d adf
Jim cree e agaad
Sam bree f adfgg
Pam tree g djg
Tom low h djhfh
Sam bree i ertr

How can I display Tom low's data only on Sheet2, Sam bree's data only on
Sheet3 and so on?

Thanks in advance

Hi

Try this:

Sub SplitData()
Dim TargetRange As Range
Dim myArr()
Dim counter As Long

Set TargetSh = Worksheets("Sheet1")
Set TargetRange = TargetSh.Range("A1", TargetSh.Range("A" &
Rows.Count).End(xlUp))
TargetRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
UniqueNames = TargetRange.SpecialCells(xlCellTypeVisible).Cells. Count
ReDim myArr(UniqueNames - 1)
For Each cell In TargetRange.SpecialCells(xlCellTypeVisible)
myArr(counter) = cell.Value
counter = counter + 1
Next
ActiveSheet.ShowAllData
For sh = 1 To UBound(myArr)
Set DestSh = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
DestSh.Name = myArr(sh)
TargetRange.AutoFilter field:=1, Criteria1:=myArr(sh)
TargetRange.SpecialCells(xlCellTypeVisible).Entire Row.Copy
DestSh.Range("A1")
TargetRange.AutoFilter
Next
End Sub

Regards,
Per

"Sam" skrev i meddelelsen
...
Hi All,

I have a Sheet with this kind of data:

ColumnA ColumnB Column C
Pam tree a asdf
Tom low b adf
Sam bree c adf
Pam tree d adf
Jim cree e agaad
Sam bree f adfgg
Pam tree g djg
Tom low h djhfh
Sam bree i ertr

How can I display Tom low's data only on Sheet2, Sam bree's data only on
Sheet3 and so on?

Thanks in advance

Morning Sam,
This code should do what you want. However, it is important that your header
names are unique if not, you may get unexpected results.

Place both procedure & function in standard module.

Sub FilterDataToSheets()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim lr As Integer
Dim c As Range

'worksheet where your data is stored
'change sheet name as required
Set ws1 = ThisWorkbook.Worksheets("Sheet1")

With ws1

lr = .Cells(.Rows.Count, "A").End(xlUp).Row


Set rng = .Range("A1:C" & lr)

'extract list
.Columns("A:A").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("J1"), Unique:=True

lr = .Cells(.Rows.Count, "J").End(xlUp).Row

'set up Criteria Area
.Range("L1").Value = .Range("A1").Value

For Each c In .Range("J2:J" & lr)
'add the name to the criteria area
.Range("L2").Value = c.Value

'sheet aleady exists
If SheetExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
'add new sheet and run advanced filter
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If


Next

.Select
.Columns("J:L").Delete

End With
End Sub

Function SheetExists(wksName As String) As Boolean
On Error Resume Next
SheetExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function


--
jb


"Sam" wrote:

Hi All,

I have a Sheet with this kind of data:

ColumnA ColumnB Column C
Pam tree a asdf
Tom low b adf
Sam bree c adf
Pam tree d adf
Jim cree e agaad
Sam bree f adfgg
Pam tree g djg
Tom low h djhfh
Sam bree i ertr

How can I display Tom low's data only on Sheet2, Sam bree's data only on
Sheet3 and so on?

Thanks in advance