ExcelBanter - Extract email from excel worksheets

Maybe this ??

The example below will copy all cells with a E-Mail Address in
Sheets("Sheet1").Range("A1:E100") to the A column of "Sheet2"
Note : I use xlPart in the code instead of xlWhole to find each cell with a @ character.

You can loop through all sheets if you want or do you mean workbooks ?

Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long

Application.ScreenUpdating = False
'You can also use more values in the Array
'myArr = Array("@", "www")
MyArr = Array("@")

Rcount = 0
With Sheets("Sheet1").Range("A1:E100")

For I = LBound(MyArr) To UBound(MyArr)
'If you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "@"
'Note : I use xlPart in this example and not xlWhole

Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
' This example will only copy the value
Sheets("Sheet2").Range("A" & Rcount).Value = Rng.Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address < FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True
End Sub

--
Regards Ron de Bruin
http://www.rondebruin.nl

wrote in message ups.com...
Hi all,

I have a question.
Because of my job... I always receiving worksheets ....
I need to extract the email address in these worksheets into a new
worksheet...
(i.e.: a new worksheet contains ALL emails address from other
worksheets... probably over 100+)

Can anyone teach me how to do this? I heard VBA can do this... but
how?

Thanks in advance.
Chan