isim aramada sorun

[önder34]

merhaba arkdaşlar sitenin yardımıyla okul için kurs takip çalışması yapmaya çalışıyorum .Arama işleminde takıldım .Ben ara sayfasında isim veya numara girince veri sayfasındaki o isme ait numaraları ve isimleri sırasın istiyorum .Çünkü birden fazla kayıt olabiliyor.Ben ara sayfasında bilgileri b sütununda arama için şu makroyu kullandım
Private Sub Worksheet_Change(ByVal Hedef As Range)
On Error Resume Next
If Hedef.Value = "" Then GoTo 10
With Sheets("veri")
Select Case Hedef.Address(0, 0)
Case Is = "A2"
i = .Range("a2:a" & .Range("a65536") _
.End(3).Row).Find(Hedef.Value, , , 1).Row
Case Is = "B2"
i = .Range("c2:c" & .Range("c65536") _
.End(3).Row).Find(Hedef.Value, , , 1).Row
Case Else
GoTo 10
End Select
If Err Then GoTo hata
Range("b5").Value = .Cells(i, "a").Value
Range("b6").Value = .Cells(i, "c").Value
Range("b7").Value = .Cells(i, "e").Value
Range("b8").Value = .Cells(i, "g").Value
Range("b9").Value = .Cells(i, "I").Value
Range("b10").Value = .Cells(i, "k").Value
Range("b11").Value = .Cells(i, "o").Value
Range("b12").Value = .Cells(i, "q").Value
Range("b13").Value = .Cells(i, "s").Value
Range("b14").Value = .Cells(i, "m").Value
Range("b16").Value = .Cells(i, "w").Value
'**********
' ya da
'Range("b16").Value = cdbl(.Cells(i, "m").Value) - ( _
cdbl(.Cells(i, "o").Value) + _
cdbl(.Cells(i, "q").Value) + _
cdbl(.Cells(i, "s").Value))
10 Exit Sub
hata:
If Err Then
MsgBox "Aradığınız veri listede yok. ", vbInformation, "www.excel.web.tr"
Err.Clear
Range("b5:b16").ClearContents
End
End If
End With
End Sub


ama birden fazla kaydı listeleyemediğim için vaz gçtim bu yöndemden şimdi yatayda nasıl yaptırabiliriz yardımlarınızı bekliyorum .

textbox kullanarak da olabilir.

 

[Orion1]

Ben F sütununa kadar yaptım.Siz devam ediniz.
Dosyanız ektedir.

Function ara(alan As Range, deg)
Dim s1 As Worksheet, k As Range, adr As String, sat As Long
Sheets("ARA").Select
Set s1 = Sheets("VERİ")
Application.ScreenUpdating = False
Range("A5:K65536").ClearContents
sat = 5
Set k = alan.Find(deg, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        Cells(sat, "A").Value = Sheets("VERİ").Cells(k.Row, "A").Value
        Cells(sat, "B").Value = Sheets("VERİ").Cells(k.Row, "C").Value
        Cells(sat, "C").Value = Sheets("VERİ").Cells(k.Row, "E").Value
        Cells(sat, "D").Value = Sheets("VERİ").Cells(k.Row, "G").Value
        Cells(sat, "E").Value = Sheets("VERİ").Cells(k.Row, "I").Value
        Cells(sat, "F").Value = Sheets("VERİ").Cells(k.Row, "K").Value
        sat = sat + 1
        Set k = alan.FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
End If
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır" & vbLf & _
"evrengizlen@hotmail.com", vbOKCancel + vbInformation, "E V R E N"
End Function

 

[önder34]

Sayın Evren Gizlen bu çalışmada sizin emeğiniz çok büyük sonsuz teşekkür ediyorum .İsim bölümüne manuel giriş yapınca sonuç alamıyorum .Ama kopyala yapıştır yapınca aranan isme ait sonuçlar geliyor. Hücrenin tüm özellikleri aynı sorun nerden acaba ben bulamadım .