Recherche une valeur et copie ensuite

Sub TrouveEtCopie()
Dim MaPlage As Range, Valeur, Tablo(1 To 3)
Dim i, xCell As Range

Set MaPlage = Selection

If MaPlage.Count < 3 Then
  MsgBox "moins de trois cellules dans le tableau => échec"
  Exit Sub
End If

For Each xCell In MaPlage
i = i + 1: Tablo(i) = xCell.Value
If i = 3 Then Exit For
Next xCell

'Trouve le mot à ne pas chercher
If Tablo(1) = Tablo(2) Then
  Valeur = Tablo(1)
ElseIf Tablo(1) = Tablo(3) Then
  Valeur = Tablo(1)
ElseIf Tablo(2) = Tablo(3) Then
  Valeur = Tablo(2)
Else
  MsgBox "A priori trois ou plus valeurs différentes dans la sélection => échec"
  Exit Sub
End If
  
MsgBox "Valeur non recherchée : " & Valeur

For Each xCell In MaPlage
  If xCell.Value <> Valeur Then Exit For
Next xCell

If xCell.Value = Valeur Then
  MsgBox "Aucune valeur diff. de " & Valeur & " présente => échec"
  Exit Sub
End If

xCell.Offset(2, 1).Resize(6, 4).Copy Destination:= _
  Sheets("Feuil2").Range("A1")

End Sub