Suponiendo que tus datos están a partir de A1:B1, mi código escribe lo que pides a partir de J1 (misma hoja, haz los cambios que creas conveniente):

Sub prueba()

  Dim celda As Range, filaU&, colD&, filaD&

  Application.ScreenUpdating = False

  filaU = Cells(Rows.Count, 1).End(xlUp).Row

  Range("CD2").FormulaR1C1 = "=IFERROR(9+MATCH(R[-1]C,R[-1]C[-72]:R[-1]C[-1],0),10+COUNTA(R[-1]C[-72]:R[-1]C[-1]))"

  For Each celda In Range("A1:A" & filaU).Cells

    Range("CD1").Value = celda.Value

    colD = Range("CD2").Value

    Cells(1, colD).Value = celda.Value

    filaD = Cells(Rows.Count, colD).End(xlUp).Row + 1

    Cells(filaD, colD).Value = celda.Offset(0, 1).Value

  Next celda

  Range("CD1:CD2").ClearContents

  Application.ScreenUpdating = True

End Sub

Si con «… Ayudar…» te refieres a hacértelo… no puedo, no debería haberte dado el anterior en modo funcional, ya que ello significa competencia desleal hacia otros profesionales que viven de eso.

Dices que lo has intentado y no lo has conseguido. Muestra lo que has hecho y donde te has bloqueado. Si es un detalle determinado y puedo, intentaré ayudarte.

Veo que cada vez que añades (o borras) una asignatura se borran todos los datos que ya tienes y se escriben de nuevo, y al escribir (o borrar) el alumno otro tanto de lo mismo (no es muy eficiente).

Pero como suele decirse por aquí «si funciona no lo cambies».

- [Aunque yo trabajaría sólo con las modificaciones, sin borrar reescribir los datos ya pasados, pero eso sí; ¡Complicaría más el código VBA!: habría que trabajar, además de con Worksheet_Change, con Worksheet_SelectionChange para identificar cuando modificas una celda vacía (estás agregando) o cuando modificas una celda con texto (estás borrando o modificando), en este evento se tendría que ‘memorizar’ los contenidos de la pareja de celdas].

Tal como lo tienes y sin complicar demasiado el código VBA; con lo resaltado en (rojo)…

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim celda As Range, filaU&, colD&, filaD&, A As Boolean, B As Boolean

  A = Cells(Target.Row, 1).Value = "": B = Cells(Target.Row, 2).Value = ""

  If A <> B Then Exit Sub

  Application.EnableEvents = False

  Application.ScreenUpdating = False

  ActiveSheet.Range("J1").CurrentRegion.Clear

  filaU = Cells(Rows.Count, 1).End(xlUp).Row 

  Range("CD2").FormulaR1C1 = "=IFERROR(9+MATCH(R[-1]C,R[-1]C[-72]:R[-1]C[-1],0),10+COUNTA(R[-1]C[-72]:R[-1]C[-1]))" 

  For Each celda In Range("A1:A" & filaU).Cells

    Range("CD1").Value = celda.Value

    colD = Range("CD2").Value

    Cells(1, colD).Value = celda.Value

    filaD = Cells(Rows.Count, colD).End(xlUp).Row + 1

    Cells(filaD, colD).Value = celda.Offset(0, 1).Value

  Next celda 

  Range("CD1:CD2").ClearContents

  Application.EnableEvents = True

  Application.ScreenUpdating = True

End Sub

… sólo ejecutas el código cuando agregas/borras asignatura y alumno, y no cuando modificas sólo uno de ellos (al menos evitas el 50% de escrituras y borrados).