New sheet Help

[smartguy]

need data in to new sheet based on school.

Excel Workbook
	A	B	C
1	Name	Class	school
2	A	1	kcz
3	b	1	ms
4	c	1	kcz
5	d	1	kcz
6	e	1	kcz
7	f	1	mcz
8	g	1	was
9	h	1	ws
10	i	1	was
11	j	1	was
12	k	1	ss
Sheet1

answer:
Sheet1

Excel Workbook
	A	B	C
1	Name	Class	school
2	A	1	kcz
3	c	1	kcz
4	d	1	kcz
5	e	1	kcz
Sheet1

Sheet2

Excel Workbook
	A	B	C
1	Name	Class	school
2	f	1	mcz
Sheet2

Etc......

 

[Norie]

Maybe something like this.

Option Explicit
 
Sub DistributeRows()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim I As Long
    
    Set wsAll = Worksheets("Sheet1") ' change All to the name of the worksheet the existing data is on
    
    LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
    
    Set wsCrit = Worksheets.Add
    
    ' column C has the criteria eg project ref
    wsAll.Range("C1:C" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
    
    LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
    For I = 2 To LastRowCrit
    
        Set wsNew = Worksheets.Add
        wsNew.Name = "School - " & wsCrit.Range("A2")
        wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
         CopyToRange:=wsNew.Range("A1"), Unique:=False
        wsCrit.Rows(2).Delete
        
    Next I
    
    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
    
End Sub

 

[smartguy]

Thanks mR. VoG.

Its Working..

Please help on that Question

http://www.mrexcel.com/forum/showthread.php?t=403594