Find email and copy to a separate cell

The following sub can help to copy the email in a row and paste to a separator. It is usefull when the email addresses occurred randomly in the Excel.

Sub Find_email()

For i = 2 To 2357
Range("A" & i, "AS" & i).Select
Cells.Find(What:="@", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False).Select

Selection.Copy
Range("AT" & i).Select
ActiveSheet.Paste
Next

End Sub