Sayfa1'den bilgi formuna veri almak

[mars2]

İyi Günler;
Çalışma kitabımın 1 sayfasında yaklaşık 2000 adet veri bulunmaktadır. Sayfa3'de bilgi formu hazırladım. D7 hüctresine taşınmaz no.sunu yazdığımda Buraya sayfa1'den verileri aktarmak istemekteyim. Ancak, taşınmaz no.su olmasına rağmen veri aktarımı yapmamakta . Dosya bulunamadı mesajı vermektedir.
Yardımlarınız için teşekkürler.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [D7]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub
Set s1 = Sheets("bilgiformu")
Set s2 = Sheets("Liste")

For Each bul In s2.Range("B5:B5000")
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then
MsgBox "ARADIĞINIZ TAŞINMAZ NO BULUNAMADI.", vbInformation, "BİLGİ"
Exit Sub
End If
s1.Cells(9, "D").Value = s2.Cells(sat, "D").Value
s1.Cells(10, "D").Value = s2.Cells(sat, "E").Value
s1.Cells(11, "D").Value = s2.Cells(sat, "F").Value
s1.Cells(12, "D").Value = s2.Cells(sat, "G").Value
s1.Cells(13, "D").Value = s2.Cells(sat, "H").Value
s1.Cells(14, "D").Value = s2.Cells(sat, "I").Value
s1.Cells(15, "D").Value = s2.Cells(sat, "J").Value
s1.Cells(15, "E").Value = s2.Cells(sat, "K").Value
s1.Cells(16, "D").Value = s2.Cells(sat, "L").Value

Set s1 = Nothing
Set s2 = Nothing

End Sub

 

[aptillah]

İyi Günler;
Çalışma kitabımın 1 sayfasında yaklaşık 2000 adet veri bulunmaktadır. Sayfa3'de bilgi formu hazırladım. D7 hüctresine taşınmaz no.sunu yazdığımda Buraya sayfa1'den verileri aktarmak istemekteyim. Ancak, taşınmaz no.su olmasına rağmen veri aktarımı yapmamakta . Dosya bulunamadı mesajı vermektedir.
Yardımlarınız için teşekkürler.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [D7]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub
Set s1 = Sheets("bilgiformu")
Set s2 = Sheets("Liste")

For Each bul In s2.Range("B5:B5000")
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then
MsgBox "ARADIĞINIZ TAŞINMAZ NO BULUNAMADI.", vbInformation, "BİLGİ"
s1.Cells(7, "D").Value = ""
s1.Cells(9, "D").Value = ""
s1.Cells(10, "D").Value = ""
s1.Cells(11, "D").Value = ""
s1.Cells(12, "D").Value = ""
s1.Cells(13, "D").Value = ""
s1.Cells(14, "D").Value = ""
s1.Cells(15, "D").Value = ""
s1.Cells(15, "E").Value = ""
s1.Cells(16, "D").Value = ""
Exit Sub
End If
s1.Cells(9, "D").Value = s2.Cells(sat, "D").Value
s1.Cells(10, "D").Value = s2.Cells(sat, "E").Value
s1.Cells(11, "D").Value = s2.Cells(sat, "F").Value
s1.Cells(12, "D").Value = s2.Cells(sat, "G").Value
s1.Cells(13, "D").Value = s2.Cells(sat, "H").Value
s1.Cells(14, "D").Value = s2.Cells(sat, "I").Value
s1.Cells(15, "D").Value = s2.Cells(sat, "J").Value
s1.Cells(15, "E").Value = s2.Cells(sat, "K").Value
s1.Cells(16, "D").Value = s2.Cells(sat, "L").Value

Set s1 = Nothing
Set s2 = Nothing

End Sub

kodlarda bi problem yok sadece d sütünunun hücre biçimlendirmesini düzeltmen yeterli...ben bide kırmızı renkli kodları ekledim..

 

[mars2]

Sayın aptillah;
İlginiz için teşekkürler, ancak hücre biçimi Genel olarak düzeltmeme rağmen veriler gelmemektedir. Neden olabilir veya başka kodla da yapabilme imkanımız varmıdır.

 

[aptillah]

Sayın aptillah;
İlginiz için teşekkürler, ancak hücre biçimi Genel olarak düzeltmeme rağmen veriler gelmemektedir. Neden olabilir veya başka kodla da yapabilme imkanımız varmıdır.

dosyanızı ekte kontrol edermisiniz...

 

[mars2]

Sayın Aptillah;
Biraz geçte olsa ilginiz için teşekkürler. örnek çalışma (kitap1) kitabında uygulama çalışmakla birlikte, kendi uygulamama uyarladığım zaman bilgiformu çalışma saygfasının D7 hücresine (hücreleri "Genel" olarak biçimlendirmeme rağmen) dosya nosu yazdığımızda veriler gelmemekle birlikte, ancak Liste sayfasından dosya nosunu kopyalayıp yapıştırdığım zaman veriler gelmektedir. Neden olabilir. Çözüme yardımcı olursanız sevinirim.