Recherche de mots identiques

Function Communs(cel1 As Range, cel2 As Range)
 Set d1 = CreateObject("Scripting.Dictionary")
 a = Split(cel1, " ")
 b = Split(cel2, " ")
 For Each c In a
   d1(UCase(c)) = ""
 Next c
 Set d2 = CreateObject("Scripting.Dictionary")
  For Each c In b
    If c <> "" And d1.Exists(UCase(c)) Then d2(c) = ""
  Next c
  Communs = Join(d2.keys, " ")
End Function

Function CommunsMAC(cel1 As Range, cel2 As Range)
  a = Split(cel1, " ")
  b = Split(cel2, " ")
  Dim d1 As New Collection
  On Error Resume Next
  For Each c In a
    d1.Add Item:=c, Key:=c
  Next c
  Dim d2 As New Collection
  For Each c In b
    If c <> "" Then
      retour = d1(c)
      If Err = 0 Then d2.Add Item:=c, Key:=c
    End If
  Next c
  For i = 1 To d2.Count
     tmp = tmp & d2(i) & " "
  Next i
  On Error GoTo 0
  CommunsMAC = tmp
End Function

Sub comp()
Dim TabMot1
Dim TabMot2


TabMot1 = Split([A1], " ")
TabMot2 = Split([A2], " ")

nbMot1 = UBound(TabMot1)
nbMot2 = UBound(TabMot2)

'MsgBox nbMot1
'MsgBox nbMot2

For Each mot1 In TabMot1
    'MsgBox mot1
    For Each mot2 In TabMot2
        If UCase(mot1) = UCase(mot2) Then
            [A3] = [A3] & " " & mot1
        End If
    Next mot2
Next mot1
   
End Sub