Combine multiple rows into a single row with concatenation

Try

Option Explicit

Sub test()
    Dim a, b(), i As Long, ii As Long, n As Long
    Dim AL As Object, txt As String, temp As String
    Set AL = CreateObject("System.Collections.ArrayList")
    a = Sheets("StudentTimetables").Range("a1").CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        txt = Join$(Array(a(i, 10), a(i, 11)), vbLf)
        If Not AL.Contains(txt) Then AL.Add txt
    Next
    ReDim b(1 To UBound(a, 1), 1 To AL.Count + 11)
    n = 1
    For i = 1 To 11
        b(n, i) = a(n, i)
    Next
    For i = 0 To AL.Count - 1
        b(n, i + 12) = AL(i)
    Next
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            txt = ""
            For ii = 1 To 6
                txt = txt & Chr(2) & a(i, ii)
            Next
            If Not .exists(txt) Then
                n = n + 1
                For ii = 1 To 11
                    b(n, ii) = a(i, ii)
                Next
                .Item(txt) = n
            End If
            temp = Join$(Array(a(i, 10), a(i, 11)), vbLf)
            b(.Item(txt), AL.IndexOf(temp, 0) + 12) = _
            Join$(Array(a(i, 7), a(i, 8)), vbLf)
        Next
    End With
    With Sheets("Result For 3 students").Cells(1).Resize(n, UBound(b, 2))
        .CurrentRegion.ClearContents
        .Value = b
        .Rows(1).Font.Bold = True
    End With
    Set AL = Nothing
End Sub