Oh hey, this works too.

Technically, not all words need catalogued if values in A1 have to exist in all cells. This just checks each word in A1 and finds which ones appear in all of the others.

Sub Eulogy()

Dim word
Dim lastrow As Long, r As Long
Dim tmp As String
Dim rngCell As Range

lastrow = Range("A" & Rows.Count).End(xlUp).Row

For Each word In Split(Cells(1, 1), " ")
    For Each rngCell In Range("A1:A" & lastrow)
        If Not InStr(1, rngCell, word) > 0 Then GoTo Skip
    Next
    If tmp = "" Then
        tmp = word
    Else
        tmp = tmp & " " & word
    End If
Skip:
Next

Range("B1") = tmp
End Sub