Archive Macro - Student Data

Hi folks,

I have a little problem writing a Macro to archive student data. PSA sheet.
I have a sheet for each student, with their associated grade, timings and number of attempts relating to different tests they do in class.

I would like to extract all student information and update the archive tab after running the macro to save me copying and pasting 30 students' data. (At the moment I have 3 students in the example).

Please note that the number of lessons will change depending on class, so the macro needs to run for each students' sheet from row 5 down until the first blank row.

I appreciate your help on this.

In a "very complicated way" ... ... very simple macro, with one modification in cell 'W1' after archiving students sheets, for testing.
Entry "Yes", to protect against re-archiving the same data.
If not needed then comment this line to prevent archiving blocking.

    wrksht.Range("w1").Value = "Yes"

Macro:

Option Explicit

Sub archive_students_scores()
Dim rOffs As Long, rw As Long, cl As Long
Dim strCrit As String
Dim valTbl As Variant
Dim wrksht As Worksheet, shtRslt As Worksheet

    rOffs = 0
    Set shtRslt = ThisWorkbook.Sheets("Archive")
    
    For Each wrksht In ThisWorkbook.Worksheets
        strCrit = wrksht.Range("w1").Value
        
        If wrksht.Name <> shtRslt.Name And (strCrit = "" Or strCrit = "No") Then
            If wrksht.Range("a4").CurrentRegion.Rows.Count > 1 Then
                
                With wrksht.Range("a4")
                    valTbl = .Offset(1, 0).Resize(.CurrentRegion.Rows.Count - 1, .CurrentRegion.Columns.Count).Value
                End With
                rw = UBound(valTbl, 1)
                cl = UBound(valTbl, 2)
                
                With shtRslt
                    rOffs = .Cells(Rows.Count, "A").End(xlUp).Row
                    
                    .Range("a2").Value = 1
                    .Range("a2:a" & rOffs + rw).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
                    With .Range("a1")
                        .Offset(rOffs, 1).Resize(rw, 1).Value = wrksht.Range("b1").Value
                        .Offset(rOffs, 2).Resize(rw, 1).Value = Trim(wrksht.Range("b2").Value)
                        .Offset(rOffs, 3).Resize(rw, cl).Value = valTbl
                    End With
                    .Range("e2:e" & rOffs + rw).NumberFormat = "0%"
                    .Range("h2:h" & rOffs + rw).NumberFormat = "0%"
                End With
                
                wrksht.Range("w1").Value = "Yes" 'Comment this line to prevent blocking archiving
            End If
        End If
        
        If Not IsEmpty(valTbl) Then Erase valTbl
    Next
    
    shtRslt.Select
    shtRslt.Range("a2").Select
    
    Set shtRslt = Nothing
    
    MsgBox "Done", vbOKOnly, "Info"
End Sub

Wonderful! Thank you so much for your help.