VBA to create variable sheets and names

[hblbs]

Hi all, I am wondering if anyone has a VBA code to create sheets and copy rows of information over to the corresponding sheet. After Ma Base there is a blank column and the subject grades are listed, for each subject I need to create a sheet including all columns up to Ma Base and the subject and after the next break the subject class group. So in the example below there would be 3 sheets created (AR, BL and CP). Within each sheet the would be 10 records copied over for AR and CP and 3 for BL based on the results(4C).

StuId

Student

Class gp

Sex

GT

Sub(s)

S

d(s)

EL

ligibility

LAC

Date of entry

1st Yr

Att %

En Base

Ma Base

AR Aut2: Year_9L

BL Aut2: Year_9L

CP Aut2: Year_9L

AR

BL

CP

1

A

9MS

M

04/09/2012

97

4b

4c

5c

4b

9xAX4

9xCs4

2

B

9IS

M

Y

04/09/2012

92

4b

4a

4a

5c

9yAX2

9yCs2

3

C

9SM

M

Y

04/09/2012

88

4b

4a

4a

4c

5c

9xAX1

9xBX

9xCs1

4

D

9IS

F

EL

30/04/2013

7

99

3b

3b

5c

5b

3a

9yAX4

9yBX

9yCs4

5

E

9qN

F

G

Gg,It,Ma,Re

04/09/2012

97

5a

5a

5b

5a

9yAX3

9yCs3

6

F

9qN

M

K

MLD,SLCN

Y

04/09/2012

95

3b

4c

5c

4c

9yAX5

9yCs5

7

G

9Ru

M

Y

04/09/2012

93

5c

4b

4a

5b

9xAX2

9xCs2

8

H

9KE

M

04/09/2012

94

4a

4b

4a

5c

4a

9yAX2

9yBX

9yCs2

9

I

9IS

M

Y

04/09/2012

4

98

4b

4b

5c

4b

9yAX5

9yCs5

10

J

9qz

M

04/09/2013

98

4b

4c

4b

4a

9xAX2

9xCs2

<tbody>
</tbody>

I could of course copy the sheets 3 times and the filter and delete the necessary columns and rows, however I have to to this with over 20 subjects of various class sizes and it would be useful if this could be automated as it is needs to be done fairly regularly for 5 year groups and 20 subjects(5*20=100 sheets to create and amend).

Thanks in advance.

 

[hblbs]

I have tried amending the following which creates a list based on rows in a sheet, but was wondering if anyone knows how to amend so that it can be used to work across columns like my scenario above.

Sub createShts()
Dim rData As Range
    Dim rCl As Range
    Dim sNm As String
    
    Set ws = Sheet1
    'extract a list of unique names
    'first clear existing list
    With ws
        Set rData = .Range(.Cells(1, 1), .Cells(Rows.Count, 3).End(xlUp))
        .Columns(256).Clear
        .Range(Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, 256), Unique:=True
    
        For Each rCl In .Range(.Cells(1, 256), .Cells(.Rows.Count, 256).End(xlUp))
            sNm = rCl.Text
            'add new sheet (only if required-NB uses UDF)
            If WksExists(sNm) Then
                'so clear contents
                Sheets(sNm).Cells.Clear
            Else
                'new sheet required
                Set wsNew = Sheets.Add
                wsNew.Move After:=Worksheets(Worksheets.Count) 'move to end
                wsNew.Name = sNm
            End If
            'AutoFilter & copy to relevant sheet
            rData.AutoFilter Field:=1, Criteria1:=sNm
            rData.Copy Destination:=Worksheets(sNm).Cells(1, 1)
        Next rCl
        End With
        ws.Columns(256).ClearContents 'remove temporary list
        rData.AutoFilter 'switch off AutoFilter
    End Sub
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function