Hi

As requested I have commented the code, please feel free to ask about anything you are not sure of.

Sub format_teacher()

Dim a As Integer
'************************************************************************************************************
'Checks the details of the classes and if the text contains "Tb" marks a "b", if it contains "Tc" marks a "c"
'or if neither an "a"
'************************************************************************************************************
For a = 2 To 73

With Sheets("Punctuality").Cells(3, a)
    Set c = .Find("Tb", LookIn:=xlValues)
    If Not c Is Nothing Then
        Let Cells(1, a).Value = "b"
    End If
End With

With Sheets("Punctuality").Cells(3, a)
    Set c = .Find("Tc", LookIn:=xlValues)
    If Not c Is Nothing Then
        Let Cells(1, a).Value = "c"
    End If
End With

If Cells(1, a).Value = "" Then Let Cells(1, a).Value = "a"

Next a

End Sub

Sub format_heading()

Dim a As Integer, b As Integer, c As Integer, d As String

'*****************************************************************************************************************
'Checks for the first space and removes anything before that, also removes "Tb " and "Tc ", cpies to temp location
'*****************************************************************************************************************

For a = 2 To 73

Let c = Len(Cells(3, a))
Let b = InStr(1, Cells(3, a), " ")
Let d = Right(Cells(3, a), c - b)
Let Cells(2, a).Value = d
Next a

    Rows(2).Replace What:="Tb ", Replacement:="", LookAt:=xlPart
    Rows(2).Replace What:="Tc ", Replacement:="", LookAt:=xlPart

End Sub

Sub copy_data()

Dim a As Integer, b As Integer, c As Integer, d As Integer, x As String

Application.ScreenUpdating = False
'****************************************************************
'Inserts two rows on the punctuation page to place temporary data
'****************************************************************
    Rows("1:2").Select
    Selection.Insert Shift:=xlDown
    Rows(2).RowHeight = 150
    Rows(2).Orientation = 90

Call format_teacher
Call format_heading

'******************************
'Copies Headings to "Rev" sheet
'******************************

Sheets("Rev").Select
Let Cells(1, 1).Value = "Student Name"
Let Cells(1, 2).Value = "Class Name"
Let Cells(1, 3).Value = "Teacher"

For d = 3 To 7
Let x = Sheets(d).Name
Let Cells(1, d + 1).Value = x
Next d
Columns("c:g").ColumnWidth = 12

'**********************************************
'Copies details for each student to "Rev" sheet
'**********************************************

For a = 4 To 213
'**********************************
'Copies Student name to "rev" sheet
'**********************************
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value + 1, 1).Value = Sheets("Punctuality").Cells(a, 1).Value
'**************************************************************
'Copies details for each student's teachers, classes and grades
'**************************************************************
For c = 2 To 73
If Sheets("Punctuality").Cells(a, c).Value <> "" Then
'****************************************************************************************************************
'Sheets("Rev").Cells(1, 15).Value enables data to be copied to the right place by counting the number of teachers
'****************************************************************************************************************

'****************************
'Copies class detais to "Rev"
'****************************
If Sheets("Rev").Cells(1, 15).Value = 0 Then
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value + 1, 2).Value = Sheets("Punctuality").Cells(2, c).Value
ElseIf Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value, 2).Value <> Sheets("Punctuality").Cells(2, c).Value Then
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value + 1, 2).Value = Sheets("Punctuality").Cells(2, c).Value
End If
End If
'****************************************************
'Copies teacher details and grades from "Punctuality"
'****************************************************
If Sheets("Punctuality").Cells(a, c).Value <> "" Then
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value + 1, 3).Value = Sheets("Punctuality").Cells(1, c).Value
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value, 4).Value = Sheets("Punctuality").Cells(a, c).Value
'***********************************
'Copies grades from all other sheets
'***********************************
For d = 4 To 7
If Sheets(d).Cells(a - 2, c).Value <> "" Then
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value, d + 1).Value = Sheets(d).Cells(a - 2, c).Value
End If
Next d
End If
Next c
Next a
Sheets("Punctuality").Rows("1:2").Delete
Application.ScreenUpdating = True
End Sub
Regards

Jeff