Try this modification
Sub Test()
Sheets("Database").Activate
Application.DisplayAlerts = False
For N = 2 To Sheets.Count
Sheets(2).Delete
Next N
Application.DisplayAlerts = True
Cells(1, 1).CurrentRegion.Sort Header:=xlYes, Key1:=Cells(1, 2), Key2:=Cells(1, 3), Key3:=Cells(1, 8)
For N = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(N, 2) <> Cells(N - 1, 2) Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Database").Activate
Sheets(Sheets.Count).Name = Cells(N, 2).Value
Sheets(Sheets.Count).Cells(1, 1) = "Exam"
Sheets(Sheets.Count).Cells(1, 2) = "Site"
Sheets(Sheets.Count).Cells(1, 3) = "Subject"
Sheets(Sheets.Count).Cells(1, 4) = "Query ID"
End If
Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Cells(N, 5)
Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = Cells(N, 3)
Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Offset(0, 2) = Cells(N, 4)
Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Offset(0, 3) = Cells(N, 1)
Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Offset(0, 3) = Cells(N, 8)
Next N
End Sub
Bookmarks