creating an additional sheet with a macro.

[Guest]

I'm working with downloaded information showing different part numbers, on occassion it will list 2 different part numbers and then 4 different part numbers. Is there a way using macros to create a sheet for each part number if it were 2 or 200 part numbers?

Thanks in advance...

 

[Ken Wright]

Easiest way to deal with it is likely to be to use a Pivot table and then use
the 'Show Pages' option which will create all the sheets for you, or as you say,
you can use a macro such as the following, which assumes your filter range 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

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

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

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

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 - 1 & " Sheets"
Next Cel

SrcRng1.AutoFilter

With SrcSht
.Activate
.Range("IV:IV").Delete
.Range("A1").Select
End With

Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 97/00/02/03

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
----------------------------------------------------------------------------

I'm working with downloaded information showing different part numbers, on

occassion it will list 2 different part numbers and then 4 different part
numbers. Is there a way using macros to create a sheet for each part number if
it were 2 or 200 part numbers?