copy and save data to multiple unique spreadsheets

[waterboy202]

Hi All

I am new in making marcos and am using Excell 2000. I was wounding if you could help me out. I am trying to make a Marco that will be able to:

-Sort by a certain column lets say X
-Copy all the rows with the same name &/or number in column X to a new spreadsheet, (keeping the header the same)
-save it, name the file to that in column X & the date data in column Y2
-then do it again till there is no more info

For example, if I have master spreadsheet with several different fruits and data about them. I want to separate all of the different info on the respective fruit into multiple spreadsheets and save them. All the apples one spread sheet all of the pears on the other one & all the Apply 1's on another. I would like to be able to save the file with the date located in Y2 along with todays date.

Could some one please help me out?

 

[venkat1926]

type the name of the fruits in A20 and below
see the sample sheet below
run this macro "test"
after running the macro if it is ok you can run the maro "undo" to remove the new sheets and again test the macro

modify the macro to suit you
the macros are

Sub test()
Dim rng As Range
Dim fruit As Range
With Worksheets("sheet1")
Set rng = Range(.Range("a1"), .Range("a1").End(xlDown))
Set fruit = .Range("a20")
line2:

rng.AutoFilter field:=1, Criteria1:=fruit.Value
Range(.Range("a1"), .Range("a1").End(xlDown).End(xlToRight)).Copy
Worksheets.Add before:=Worksheets(Worksheets.Count)
ActiveSheet.Name = fruit.Value
Range("a1").PasteSpecial
Set fruit = fruit.Offset(1, 0)
If fruit = "" Then GoTo line1
.Range("a1").AutoFilter

GoTo line2:
End With
line1:
Worksheets("sheet1").Range("a1").AutoFilter
MsgBox "macro over"
End Sub

Sub undo()
On Error GoTo line1
Application.DisplayAlerts = False
Sheets(Array("apple", "banana", "pear")).Delete
line1:
Application.DisplayAlerts = True


End Sub

Book2
	A	B	C	D
1	fruit	data
2	apple	1
3	pear	2
4	banana	3
5	apple	4
6	apple	5
7	banana	6
8	pear	7
9	banana	8
10
11
12
13
14
15
16
17
18
19
20	apple
21	banana
22	pear
Sheet1