XL 2013 Extraire email

Function TrouveAdresse(C)
    TrouveAdresse = ""
    If C = "" Then Exit Function
    C1 = Split(Split(C, "@")(0), "'")
    C2 = Split(Split(C, "@")(1), "'")
    TrouveAdresse = C1(UBound(C1)) & "@" & C2(0)
End Function

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