Show pages

  • Thread starter Thread starter Clyde Lomax
  • Start date Start date
C

Clyde Lomax

I was recently introduced to this really helpful item on a Pivot table (show
pages).

Now if someone would be so kind as to let me know how to do something
similar from a worksheet I would be Grateful.

A B C
1 1 6 9
2 2 7 8
3 3 3 3
4 3 4 1
5 2 6 4
6 1 6 6

What the end result would be is tabs Named 1, 2 & 3 with the data for each
row on the new sheet, all 1's together, all 2's together.etc

Thanks in advance.
Lomax
 
Quick and dirty. Assumes range of data to be filtered starts in A1 and has
headers. No error checking included to look for anything like sheet names
already existing for values in your list of names.

Sub FilterData()

Dim SrcSht As Worksheet
Dim SrcShtlrow As Long
Dim SrcShtlCol As Long
Dim FiltRnglrow As Long
Dim FiltRng As Range
Dim SrcRng1 As Range
Dim SrcRng2 As Range
Dim NewSht As Worksheet
Dim NumShts As Long
Dim Cel As Range

Set SrcSht = ActiveSheet
SrcSht.Name = "Source Data Sheet"
SrcShtlrow = SrcSht.Cells(Rows.Count, "A").End(xlUp).Row

SrcShtlCol = ActiveSheet.UsedRange.Column - 1 + _
ActiveSheet.UsedRange.Columns.Count

Set SrcRng1 = SrcSht.Range(Cells(1, "A"), Cells(SrcShtlrow, "A"))
Set SrcRng2 = SrcSht.Range(Cells(1, "A"), Cells(SrcShtlrow, SrcShtlCol))

SrcRng1.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("IV1"), Unique:=True

FiltRnglrow = SrcSht.Cells(Rows.Count, "IV").End(xlUp).Row
Set FiltRng = SrcSht.Range(Cells(2, "IV"), Cells(FiltRnglrow, "IV"))

FiltRng.Sort Key1:=Range("IV2"), Order1:=xlAscending, Header:=xlGuess

For Each Cel In FiltRng
Set NewSht = Worksheets.Add
NewSht.Name = Cel.Value
NumShts = Sheets.Count
NewSht.Move After:=Sheets(NumShts)

With SrcRng2
.AutoFilter Field:=1, Criteria1:=Cel.Value
.SpecialCells(xlCellTypeVisible).Copy NewSht.Range("A1")
End With
Next Cel

SrcRng1.AutoFilter
SrcSht.Range("IV:IV").Delete
SrcSht.Activate
SrcSht.Range("A1").Select

End Sub
 
Back
Top