Sub Essai()
Dim T, n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
Dim chn$, p1%, p2%, i&: n = n - 1: T = [A2].Resize(n, 2)
For i = 1 To n
chn = T(i, 1): p2 = InStr(chn, "@")
If p2 > 0 Then
p1 = InStrRev(chn, "'", p2)
If p2 > 0 Then
p2 = InStr(p2, chn, "'"): If p2 > 0 Then T(i, 2) = Mid$(chn, p1, p2 - p1)
End If
End If
Next i
[B2].Resize(n) = Application.Index(T, Evaluate("Row(" & "1:" & n & ")"), 2)
End Sub