Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim SheetBottom As Integer
Dim TeacherSheet As String
Dim TeacherSheetStart As Integer
Dim TeacherSheetBottom As Integer
Dim wb As String
Dim ws As Worksheet
Dim wt As Worksheet
Dim z As Integer
On Error GoTo EndMacro
wb = ThisWorkbook.Name
Set ws = Workbooks(wb).Worksheets("Students")
i = ws.Cells(Rows.Count, 1).End(xlUp).Row
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
TeacherSheetStart = 3
For Each wt In Worksheets
If wt.Name <> "Students" Then
SheetBottom = Worksheets(wt.Name).Cells(Rows.Count, 1).End(xlUp).Row
If SheetBottom > TeacherSheetStart Then
Worksheets(wt.Name).Range("a" & TeacherSheetStart, "d" & SheetBottom).ClearContents
End If
End If
Next wt
For z = 2 To i
TeacherSheet = UCase(ws.Cells(z, 3))
If TeacherSheet <> "" Then
TeacherSheetBottom = Workbooks(wb).Worksheets(TeacherSheet).Cells(Rows.Count, 1).End(xlUp).Row
If TeacherSheetBottom < TeacherSheetStart - 1 Then TeacherSheetBottom = TeacherSheetStart - 1
Workbooks(wb).Worksheets(TeacherSheet).Range("a" & TeacherSheetBottom + 1) = ws.Range("a" & z)
Workbooks(wb).Worksheets(TeacherSheet).Range("b" & TeacherSheetBottom + 1) = ws.Range("b" & z)
Workbooks(wb).Worksheets(TeacherSheet).Range("c" & TeacherSheetBottom + 1) = ws.Range("d" & z)
Workbooks(wb).Worksheets(TeacherSheet).Range("d" & TeacherSheetBottom + 1) = ws.Range("e" & z)
End If
Next z
For Each wt In Worksheets
If wt.Name <> "Students" Then
SheetBottom = Worksheets(wt.Name).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(wt.Name).Range("a" & TeacherSheetStart, "d" & SheetBottom).Sort Key1:=wt.Range("a3" & TeacherSheetStart), Order1:=xlAscending, Key2:=wt.Range("b3" & TeacherSheetStart), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
End If
Next wt
EndMacro:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub