Hi Robert,

with quite some ways of improvement left for your students,
and for you: ;-)

Sub Test411()
' ---
Dim lClr As Long ' color
If InStr(Environ$("Username"), "Weber") > 0 Then
  lClr = wdColorYellow
Else
  lClr = wdColorBlue
End If
' ---
Dim oTbl(1 To 2) As Table ' array of tables
Dim lRw1 As Long          ' counter for rows in table 1
Dim lRw2 As Long          ' counter for rows in table 2
Dim lCnt As Long          ' just another counter
Dim sTmp As String        ' temporary string
Dim rWr1 As Range         ' range of a word in table 1
Dim rWr2 As Range         ' range of a word in table 2
Dim sEoC As String        ' end of cell mark

Set oTbl(1) = ActiveDocument.Tables(1)
Set oTbl(2) = ActiveDocument.Tables(2)
sEoC = Chr(13) & Chr(7)

For lRw1 = 2 To oTbl(1).Rows.Count
  Set rWr1 = oTbl(1).Rows(lRw1).Cells(1).Range.Words(1)
  If rWr1 <> sEoC Then
     If rWr1.Font.Shading.BackgroundPatternColor = lClr Then
        rWr1.Select ' testing
        For lRw2 = 1 To oTbl(2).Rows.Count
           Set rWr2 = oTbl(2).Rows(lRw2).Cells(1).Range.Words(1)
           If rWr1 = rWr2 Then
              rWr2.Select ' testing
              For lCnt = 2 To 3
                 sTmp = oTbl(2).Cell(lRw2, lCnt).Range.Text
                 sTmp = Left(sTmp, Len(sTmp) - 2)
                 ' cut off end of cell mark
                 oTbl(1).Cell(lRw1, lCnt).Range.Text = sTmp
              Next
           End If
        Next
     End If
  End If
Next
End Sub

Beware of linebreaks by the newsreader!

The drawbacks are:
1st, Words definition of a word
2nd, the assumption, that for each word in column1 of table 1
there isn't more than one match in column1 of table 2!!!
3rd, I switched form the concept of words to string
in the middle of the code without reason.
Have your students correct it. LoL

My philosophy in programming is:
First, show your solution,
then, ask whether anybody can proof that you are wrong,
if not so, there is a solution!
Or you got lazy students.
Then turn to optimization.

Schoenen Tag noch.