Внимание вопрос по поиску!

[alexkey]

есть список клиентов с электронными адрессами, в поиск я забиваю @ и мне выдает все электронные адресса, теперь мне их надо скопировать в блокнот..............как скопировать!?!?!?!:confus ed:

[motorway]

а где он есть и в каком виде?

[alexkey]

Сообщение от motorway

а где он есть и в каком виде?

список таблицой ексель шесть колонок, имя, фамилия, отдел, телефон, адрес, так вот в колонке адресс, через н-количество строк вписаны в перемешку и электронные адресса...............их надо достать

[EducatedFool]

Без примера файла, и объяснения, что именно и куда копировать, ответа Вы не дождётесь.

[alexkey]

Сообщение от EducatedFool

Без примера файла, и объяснения, что именно и куда копировать, ответа Вы не дождётесь.

пример выслать или как объяснить?

[EducatedFool]

Прикрепите файл к сообщению (в расширенном режиме), предварительно упаковав его в архив.

[alexkey]

Вот надо достать все электронные адресса

[EducatedFool]

Поменьше файла не нашлось?
Можно было оставить только пару листов...

Вот надо достать все электронные адресса

Ну, допустим, достали.
И что с ними делать дальше?

[alexkey]

Сообщение от EducatedFool

Поменьше файла не нашлось?
Можно было оставить только пару листов...


Ну, допустим, достали.
И что с ними делать дальше?

Вариант1: отправить мне
вариант 2: подсказать как достать
вариант 3 : ваш вариант

[EducatedFool]

Выбрал вариант 1 + вариант 2:

Sub test()
    On Error Resume Next: Filename = "c:\emails.txt": Kill Filename
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.CreateTextFile(Filename, True)
    Dim sh As Worksheet, cell As Range: Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        For Each cell In sh.UsedRange
            If cell Like "*@*" Then ts.Write cell & vbNewLine
        Next cell
        DoEvents
    Next sh
    Application.ScreenUpdating = True: ts.Close
End Sub

Макрос за секунду создаст на диске файл C:\emails.txt со списком всех адресов: