Veri almada hata

[mars2]

İyi Akşamlar;

excel çalışma kitabımın Liste (Sayfa1) sayfasında Liste, Kayıt (Sayfa2) sayfasında ise tablo bulunmaktadır. Kayıt (Sayfa2) sayfasındaki tabloya dosya nolarına göre veriler aktarmak istiyorım. Ancak, B18 ila B25 arasındaki hücrelere Liste sayfasındaki isimleri alt alta gelecek şekilde olması gerekmektedir.

Kayıt sayfasında bulunan tablonun 1. bölümüne aşağıdaki makro ile veriler gelmektedir.

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Intersect(Target, [C4]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub

Set S1 = Sheets("kayıt")
Set S2 = Sheets("Liste")

Range("C7:C12").ClearContents
Range("G9:G10").ClearContents
Range("B18:B25").ClearContents

For Each bul In S2.Range("B5:B5000")
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then
MsgBox "ARADIĞINIZ BULUNAMADI.", vbInformation, "BİLGİ"

Exit Sub
End If

S1.Cells(7, "C").Value = S2.Cells(sat, "D").Value
S1.Cells(8, "C").Value = S2.Cells(sat, "E").Value
S1.Cells(9, "C").Value = S2.Cells(sat, "G").Value
S1.Cells(10, "C").Value = S2.Cells(sat, "I").Value
S1.Cells(12, "C").Value = S2.Cells(sat, "F").Value

S1.Cells(9, "G").Value = S2.Cells(sat, "H").Value
Set S1 = Nothing
Set S2 = Nothing

If Not Intersect(Range("C4"), Target) Is Nothing Then
.......

Ancak, B18 ila B25 hücrelerine verilerin gelebilmesi için aşağıdaki makroyu eklediğimde (Daha önceden yayımlanan makroyu uyarladığımda) hiç veri gelmemeketedir.

If Not Intersect(Range("C4"), Target) Is Nothing Then
Application.EnableEvents = False
Target.Offset(4).Resize(3).Value = ""
Cells(18, Target.Column) = ""
With Worksheets("Liste")
Set bul = .Range("B2:B5000").Find(what:=Target.Text, lookat:=xlWhole)
If Not bul Is Nothing Then
Isimler = Split(.Cells(bul.Row, "Q").Text, ",")
If UBound(Isimler) < 0 Then
Cells(18, Target.Column) = .Cells(bul.Row, "Q").Text
Else
For Bak = 0 To UBound(Isimler)
Cells(18 + Bak, Target.Column) = Isimler(Bak)
Next
End If
End If
End With
End If
End Sub

Acaba nerede hata yapılmaktadır.

 

[Korhan Ayhan]

Merhaba,

Dosya numarasına ait ADI SOYADI sayısı 10 satırı geçebiliyor mu? Geçme durumu varsa KAYIT sayfasında ADI SOYADI alanına satır eklenmesi gerekir.