Aynı sayfada farklı hücredeki değere göre veri getirme

[mars2]

İyi Akşamlar;
etiket sayfasında C9 ve I9 hücrelerine no girerek istenilen verileri Liste sayfasından almak istiyorum.

Aşağıdaki makro C9 hücresine yazdığım nosu ile veriler gelmektedir.

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

Set S1 = Sheets("etiket")
Set S2 = Sheets("Liste")

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

Exit Sub
End If
S1.Cells(13, "C").Value = S2.Cells(sat, "G").Value
S1.Cells(17, "C").Value = S2.Cells(sat, "H").Value

Ancak yine aynı sayfada bulunan aşağıdaki makro ile I9 hücresine yazdığım no ile veriler gelmektedir.

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

S1.Cells(13, "I").Value = S2.Cells(sat, "G").Value
S1.Cells(17, "I").Value = S2.Cells(sat, "H").Value

Set S1 = Nothing
Set S2 = Nothing


Saydaki makronun tamamı
Private Sub Worksheet_Change(ByVal Target As Range)

'Bilgi Getirme

On Error Resume Next

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

Set S1 = Sheets("etiket")
Set S2 = Sheets("Liste")

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

Exit Sub
End If

S1.Cells(13, "C").Value = S2.Cells(sat, "G").Value
S1.Cells(17, "C").Value = S2.Cells(sat, "H").Value
'
If Intersect(Target, [I9]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub

Set S1 = Sheets("etiket")
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 Kişi BULUNAMADI.", vbInformation, "BİLGİ"

Exit Sub
End If

S1.Cells(13, "I").Value = S2.Cells(sat, "G").Value
S1.Cells(17, "I").Value = S2.Cells(sat, "H").Value


Set S1 = Nothing
Set S2 = Nothing

End Sub

Konu hakkında nerede hata yapmakta olduğum ve yardımlarınızı esirgemeyeceğiz dileğimle

 

[muhasebeciyiz]

Makronuzun amacı etiket sayfasındaki C9 ve I9 hücrelerine yazılan numaralara göre, Liste sayfasından ilgili verileri alıp, etiket sayfasında C13, C17, I13, I17 hücrelerine yazmak.

Worksheet_Change içinde hem C9 hem de I9 kontrolü var, ancak bunlar ayrı ayrı çalışıyor.
Eğer C9 ve I9 birlikte kontrol edilirse, ikinci kontrol (örneğin I9) hiç çalışmayabilir çünkü Exit Sub ile makro erken sonlanıyor.

 

[muhasebeciyiz]

Makromuz daha sade halde olup makro bir değer arar ve bulursa istenen hücrelere verileri yazar:

Kod tekrarından kurtulduk.İstediğiniz başka hücrelerde aynı işlemi yapmak isterseniz sadece fonksiyonu tekrar çağırmanız yeterli.
Farklı bakış açısıyla düzenlendi

 

[mars2]

Sayın muhasebeciyiz;

Konu hakkında yardım ve cavaplarınız için teşekkürler.