Sub Test()
    Dim a, ws As Worksheet, sh As Worksheet, lr As Long, m As Long, n As Long, c As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("1")
        Set sh = ThisWorkbook.Worksheets("Target")
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        sh.Cells.ClearContents
        sh.Range("A1").Resize(, 7).Value = Array("A", "E", "T", "LEV", "YEAR", "ID", "GRADE")
        a = ws.Range("A3:D" & lr).Value
        n = UBound(a, 1)
        For c = 5 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
            m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
            sh.Range("A" & m).Resize(n, UBound(a, 2)).Value = a
            sh.Range("E" & m).Resize(n).Value = ws.Cells(2, c).Value
            sh.Range("F" & m).Resize(n).Value = ws.Cells(1, c).Value
            sh.Range("G" & m).Resize(n).Value = ws.Cells(3, c).Resize(n).Value
        Next c
    Application.ScreenUpdating = True
    MsgBox "Done...", 64
End Sub