Ara Bul Yaz Makrosu Yardım

[meyill]

Sayfa1!F2:J1180 aralığında birden fazla isim bulunmaktadır. Bu isimlerin bir çoğu aynıdır. Herhangi bir ismi aradığımda bu isimlerin bulunduğu satır ve sutunu alt alta sıralı bir şekilde sayfa2!A1:A100 e yazdırmak istiyorum.

Find konumutu ile aradığımda sadece bir tek ismin bulunduğu satır ve sutun yazılmakta.

Forumda bu örnekler vardı fakat hiçbiri kendi istediğim şekle uyduramadım. Yardımlarınız için teşekkür ederim.

 

[Orion1]

A sütununa satırı,B sütununa sütunu yazar.

Sub bul59()
Dim k As Range, sh As Worksheet, adr As String, deg As Variant, sat As Long
Set sh = Sheets("Sayfa2")
sh.Range("A:B").ClearContents
sat = 1
deg = InputBox("Lütfen aranacak veriyi giriniz?", "evrengizlen@hotmail.com")
If deg = "" Then Exit Sub
Set k = Range("F2:J1180").Find(deg, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        sh.Cells(sat, "A").Value = k.Row
        sh.Cells(sat, "B").Value = k.Column
        sat = sat + 1
        Set k = Range("F2:J1180").FindNext(k)
    Loop While Not k Is Nothing And adr <> k.Address
End If
sh.Select
End Sub

 

[meyill]

Evren bey Teşekkür ederim.

 

[Orion1]

Evren bey Teşekkür ederim.

Rica ederim.
İyi çalışmalar.