DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bul As Range
If Not Intersect(Target, Range("B22")) Is Nothing Then
With Worksheets("PERSONEL DATA")
Set Bul = .Range("A:A").Find(Target.Text, LookAt:=xlWhole)
If Bul Is Nothing Then
MsgBox "Personel bulunamadı.", vbExclamation
Else
Range("A1") = .Cells(Bul.Row, "B") 'ADRES1
Range("A2") = .Cells(Bul.Row, "C") 'ADRES2
Range("A3") = .Cells(Bul.Row, "D") 'MATRAH
Range("A4") = .Cells(Bul.Row, "E") 'VERGİ
Range("A5") = .Cells(Bul.Row, "F") 'TL
End If
End With
End If
End Sub
Merhaba.
"yazdırlacak" adlı sayfanın kod sayfasına aşağıdaki kodları kopyalayın.
Kod:Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Bul As Range If Not Intersect(Target, Range("B22")) Is Nothing Then With Worksheets("PERSONEL DATA") Set Bul = .Range("A:A").Find(Target.Text, LookAt:=xlWhole) If Bul Is Nothing Then MsgBox "Personel bulunamadı.", vbExclamation Else Range("A1") = .Cells(Bul.Row, "B") 'ADRES1 Range("A2") = .Cells(Bul.Row, "C") 'ADRES2 Range("A3") = .Cells(Bul.Row, "D") 'MATRAH Range("A4") = .Cells(Bul.Row, "E") 'VERGİ Range("A5") = .Cells(Bul.Row, "F") 'TL End If End With End If End Sub
Dosyanızın neresine hangi veri yazılacak net belli olmuyor. Ben A1-A5 arasına yazdım siz doğru adresleri yazıp kodlar düzenlersiniz.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bul As Range
If Not Intersect(Target, Range("B22")) Is Nothing Then
With Worksheets("PERSONEL DATA")
Set Bul = .Range("A:A").Find(Target.Text, LookAt:=xlWhole)
If Bul Is Nothing Then
MsgBox "Personel bulunamadı.", vbExclamation
Else
Range("B23") = .Cells(Bul.Row, "B") 'ADRES1
Range("B25") = .Cells(Bul.Row, "C") 'ADRES2
End If
End With
End If
End Sub