create new sheets

[JIM.H.]

Hello,
I have source excel file which
has "name", "desc", "count" columns. This is sorted
by "name". Now I need to create another excel file which
will create a sheet called with the value in "name" and
copy all "desc" and "count" to this sheat for
that "name". Repeat this for all "name"s. So I am
dividing a huge sheet into different sheets based
on "name" column. How can I do this fast and easily?
Thanks,
Jim.

 

[Ken Wright]

You can do this with a Pivot Table by putting the 'Name' field in the Page
fields, showing the Pivot table Toolbar and using the Show Pages option, or

assuming your 'Name' data is in Col A


Sub ShowPagesLikePivotTable()

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

Application.ScreenUpdating = False

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
Application.StatusBar = "Generated " & Cel.Row & " of " & FiltRnglrow & "
Sheets"
Next Cel

SrcRng1.AutoFilter
SrcSht.Range("IV:IV").Delete
SrcSht.Activate
SrcSht.Range("A1").Select
Application.StatusBar = False
Application.ScreenUpdating = True

End Sub