emails

[jillibillijames]

Hi,

My excel workbook has emails in different sheets (25 sheets) with other data included. I wanted to paste all emails (only emails) in a new sheet.Can anyone help me Please.

Thanks in Advance

Regards
Jillibillijames

 

[MrKowz]

What range would the emails appear in with each worksheet? Also, would they be identifiable by looking in the cell for an "@" symbol?

 

[jillibillijames]

Hi,

The range would be A1:F23 and the are identified with "@"

Thanks
Jillibillijames

 

[MrKowz]

Try this code out - it is untested, so be sure to run it on a copy of your data:

Public Sub FindEMails()
Dim rng     As Range, _
    rng1    As String, _
    ws      As Worksheet, _
    ws2     As Worksheet, _
    rowx    As Long
    
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
Sheets.Add
ActiveSheet.Name = "E-Mails"
rowx = 2
Set ws2 = Sheets("E-Mails")
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "E-Mails" Then
        With ws.Range("A1:F23")
            Set rng = .Find("@", LookIn:=xlValues, LookAt:=xlPart)
            If Not rng Is Nothing Then
                rng1 = rng.Address
                Do
                    ws2.Range("A" & rowx).Value = rng.Value
                    rowx = rowx + 1
                Loop While Not rng Is Nothing And rng.Address <> rng1
            End If
        End With
    End If
Next ws
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG01Jun38
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Em [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ws [COLOR="Navy"]As[/COLOR] Worksheet
ReDim Ray(1 To Rows.Count)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ws [COLOR="Navy"]In[/COLOR] Worksheets
        [COLOR="Navy"]Set[/COLOR] Rng = Sheets(Ws.Name).UsedRange
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                Em = Split(Dn, " ")
                    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Em)
                        [COLOR="Navy"]If[/COLOR] InStr(Em(n), "@") [COLOR="Navy"]Then[/COLOR]
                            c = c + 1
                            Ray(c) = Em(n)
                            [COLOR="Navy"]Exit[/COLOR] For
                        [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]Next[/COLOR] n
            [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]Next[/COLOR] Ws
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "eMails"
ActiveSheet.Range("A1").Resize(c) = Application.Transpose(Ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[jillibillijames]

hi,

Both the codes din't work.

Thanks
jillibillijames

 

[MickG]

Without further explanation, it would be difficult to know why!!
Can you Post an example of one of your sheets and also explain what error you got.
Mick

 

[jillibillijames]

Hi,
This is an example of how my sheet looks

<table border="0" cellpadding="0" cellspacing="0" width="550"><col style="width: 169pt;" width="225"> <col style="width: 75pt;" span="2" width="100"> <col style="width: 94pt;" width="125"> <tbody><tr style="height: 87.95pt;" height="117"> <td class="xl66" style="height: 87.95pt; width: 169pt;" height="117" width="225">11 4343-4403
11 4343-5555 embalaje@showpacket.com.ar mercanciaspeligrosas@showpac ket.com.ar www.showpacket.com.ar
</td> <td class="xl66" style="width: 75pt;" width="100">1A1 1A2 1G
1H1 1H2
</td> <td class="xl66" style="width: 75pt;" width="100">4C1 4C2 4D
4DV 4F 4FV
4G 4GU 4GV
4H 4PV
</td> <td class="xl66" style="width: 94pt;" width="125">IP1 IP2 IP3 IP3A IP5 IP6 3A1 3H1
6HA1 Div. 6.2 (PI 602/650)
</td> </tr> <tr style="height: 60pt;" height="80"> <td class="xl66" style="height: 60pt; border-top: medium none; width: 169pt;" height="80" width="225">(02) 8338 1544 (02) 8338 1522 adam.rowlison@dgiglobal.com www.dgiglobal.com
</td> <td class="xl65" style="border-top: medium none; width: 75pt;" width="100"> </td> <td class="xl66" style="border-top: medium none; width: 75pt;" width="100">4G various sizes
</td> <td class="xl66" style="border-top: medium none; width: 94pt;" width="125">Div. 6.2
(PI 602/650)
</td> </tr> <tr style="height: 60pt;" height="80"> <td class="xl66" style="height: 60pt; border-top: medium none; width: 169pt;" height="80" width="225">(03) 9338 3812 (03) 9338 2812 ben.gothard@dgiglobal.com www.dgiglobal.com


Thanks
Jillibillijames
</td> <td class="xl65" style="border-top: medium none; width: 75pt;" width="100"> </td> <td class="xl66" style="border-top: medium none; width: 75pt;" width="100">4G various sizes
</td> <td class="xl66" style="border-top: medium none; width: 94pt;" width="125">Div. 6.2
(PI 602/650)
</td> </tr> </tbody></table>

 

[MickG]

These were the Addresses returned from your sheet, this was amongst the Addresss from 5 other sheets.
When you ran the code did the code add a Worksheet "EMail" if so delete that sheet and try again ,only delete the line that says "Exit for", in case there is more than one address in any one line.
If there is no "eMail" sheet, the code is not running. How are you trying to run the code ???

<TABLE style="WIDTH: 192pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=256 border=0 x:str><COLGROUP><COL style="WIDTH: 48pt" span=4 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 144pt; BORDER-BOTTOM: #e0dfe3; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-ignore: colspan" width=192 colSpan=3 height=17>embalaje@showpacket.com.ar</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; WIDTH: 48pt; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent" width=64></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-ignore: colspan" colSpan=4 height=17>mercanciaspeligrosas@showpac</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-ignore: colspan" colSpan=3 height=17>adam.rowlison@dgiglobal.com</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-ignore: colspan" colSpan=3 height=17>ben.gothard@dgiglobal.com

Mick


</TD><TD style="BORDER-RIGHT: #e0dfe3; BORDER-TOP: #e0dfe3; BORDER-LEFT: #e0dfe3; BORDER-BOTTOM: #e0dfe3; BACKGROUND-COLOR: transparent"></TD></TR></TBODY></TABLE>

 

[Maheshp]

Hi

check whether this help
http://www.rondebruin.nl/sendmail.htm