Excel 2000 Create multiple sheets from Sheet1

[gahill]

My data is arranged in the following columns.

Rows over 2000 but less than 3000

Sorted by Item number within Category.


A B C D E

Catg ItemNbr Desc U/M Price
20ws 11111 AAAA BX 5.00
20ws 22222 BBBB BX 5.50
20yl 11111 AAAA BNDL 7.00
20yl 22222 BBBB BNDL 7.50

Management would like the Headings, and the Data from columns A - E and however many rows in that Category put in a seperate sheet and the sheet name as the category name.

What would be the best way to accomplish this in VBA.

Any help would be appreciated.

Thanks

Gary W. Hill

 

[xlbo]

no need for VBA

PivotTable:
Catg = PAGE field
ItemNbr = ROW field
Desc = ROW field
U/M = ROW field
AVERAGE of PRICE as VALUE field

Then, right click on pivottable and choose "Show Pages". Select 'Catg' et voila

 

[gahill]

xlbo:

Thanks for your reply but a pivot table will not work here.
There are approximately 45 categorys and each one needs to be on its on worksheet along with the corresponding items.
Thanks

 

[GVF]

gahill,

Here is a snippet that will check cells of the activesheet starting with row 1 column 1 and go to the right until it reaches an empty cell (in row 1). A new worksheet gets added and the name of the sheet is changed to the contents of the activecell of the original sheet. The data is then copied and pasted into the new sheet. All sheets are in the same workbook. If an error occurs when programatically changing the name of the sheet, a built in dialog comes up. If the dialog is canceled, the new sheet is deleted and the sub is exited.

It's a start anyway.

Sub SplitData()
On Error Resume Next
Cells(1, 1).Select
OldSheet = ActiveSheet.Name
Do While ActiveCell.Value <> ""
NewSheetName = ActiveCell.Value
Sheets.Add
Err.Clear
ActiveSheet.Name = NewSheetName
If Err <> 0 Then
NewSheetName = Application.Dialogs(xlDialogWorkbookName).Show
If NewSheetName = False Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Exit Sub
End If
End If
Sheets(OldSheet).Activate
Columns(ActiveCell.Column).Copy
Sheets(NewSheetName).Activate
Cells(1, 1).Select
ActiveSheet.Paste
Sheets(OldSheet).Activate
ActiveCell.Offset(0, 1).Select
Loop
End Sub

Greg