Süzme işlemi yrdım acil

[defacto16]

elimde bir adres listesi var fakat ben bu listeden sadece e mailleri almak istiyorum.Bunu nasıl yapabilirim ? ekteki dosyada liste mevcut.

 

[Ali]

C1 hücresine

=A1 yazın.

A2 hücresinede

=KAYDIR($A$1;SATIRSAY($C$1:C1)*10;0)

yazıp aşağı doğru çekiniz.

D1 hücresine

=B8 yazın.

D2 hücresinede

=KAYDIR($B$8;SATIRSAY($C$1:C1)*10;0)

yazıp aşağı doğru çekiniz.

 

[Orion1]

Dosyanız ekte.

Sub email_al()
Dim hcr As Range, myarr(), a As Long
Sheets("Sayfa1").Select
ReDim myarr(1 To 1, 1 To 1)
For Each hcr In Range("A1:A" & Cells(65536, "A").End(xlUp).Row)
    If hcr.Value = "E-Posta" Then
        a = a + 1
        ReDim Preserve myarr(1 To 1, 1 To a)
        myarr(1, a) = hcr.Offset(0, 1).Value
    End If
Next
Application.ScreenUpdating = False
Range("C2:C65536").Clear
Range("C1").Resize(UBound(myarr, 2), 1) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "E-Posta adresleri C sütununa çıkarıldı", vbOKOnly + vbInformation, "E-Posta"
End Sub

 

[defacto16]

Çok teşekkürederim.Hemen deniyorum