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