• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Farklı iki sayfadan veri alma

  • Konbuyu başlatan Konbuyu başlatan mars2
  • Başlangıç tarihi Başlangıç tarihi

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
617
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
İyi günler;

Aşağıdaki makro ile C3 hücresindeki veriye sayfa2'den verileri alıyorum.

Ancak sayfa3(Anasa) nden de veri almaya çalıştğımda alamıyorum hatyı nerede yapıyorum. bu konuda yardımcı olursanız sevinirim.

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
If Intersect(Target, [C3]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub

Set s1 = Sheets("bilgiformu")
Set s2 = Sheets("liste")
Set s3 = Sheets("anasayfa")


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

Exit Sub
End If

s1.Cells(4, "C").Value = s2.Cells(sat, "D").Value
s1.Cells(5, "C").Value = s2.Cells(sat, "E").Value

s1.Cells(6, "C").Value = s2.Cells(sat, "G").Value
s1.Cells(7, "C").Value = s2.Cells(sat, "H").Value
s1.Cells(8, "C").Value = s2.Cells(sat, "I").Value
s1.Cells(9, "C").Value = s2.Cells(sat, "L").Value


For Each bul In s3.Range(("B5:B2500"))
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then

Exit Sub
End If

s1.Cells(25, "C").Value = s3.Cells(sat, "Q").Value
s1.Cells(26, "C").Value = s3.Cells(sat, "R").Value


Set s1 = Nothing
Set s2 = Nothing
Set s3 = Nothing

end sub
 
MsgBox "ARADIĞINIZ BİLGİ BULUNAMADI.", vbInformation, "BİLGİ"

Exit Sub ifadesindeki


Exit sub ı silin.
 
Son düzenleme:
Sayın ekoert;

If Intersect(Target, [C3]) Is Nothing Then Exit Sub
buradaki exit Sub kaldırdığımda hata veriyor

MsgBox "ARADIĞINIZ BİLGİ BULUNAMADI.", vbInformation, "BİLGİ"

Exit Sub kaldırdığımda anasayfadan veri alamıyorum.
 
Aşağıdaki şekilde deneyin ya da örnek dosya ekleyerek bize yardımcı olun ki biz de size yardımcı olalım.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
If Intersect(Target, [C3]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub

Set s1 = Sheets("bilgiformu")
Set s2 = Sheets("liste")
Set s3 = Sheets("anasayfa")


For Each bul In s2.Range(("B5:B2500"))
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then
MsgBox "ARADIĞINIZ BİLGİ BULUNAMADI.", vbInformation, "BİLGİ"
Goto 10
'Exit Sub
End If

s1.Cells(4, "C").Value = s2.Cells(sat, "D").Value
s1.Cells(5, "C").Value = s2.Cells(sat, "E").Value

s1.Cells(6, "C").Value = s2.Cells(sat, "G").Value
s1.Cells(7, "C").Value = s2.Cells(sat, "H").Value
s1.Cells(8, "C").Value = s2.Cells(sat, "I").Value
s1.Cells(9, "C").Value = s2.Cells(sat, "L").Value

10:
For Each bul In s3.Range(("B5:B2500"))
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then

Exit Sub
End If

s1.Cells(25, "C").Value = s3.Cells(sat, "Q").Value
s1.Cells(26, "C").Value = s3.Cells(sat, "R").Value


Set s1 = Nothing
Set s2 = Nothing
Set s3 = Nothing

end sub
 
Geri
Üst