otomatik yazdırma

[aligunes]

a sutunda sicil b sutunda isimler var a ve b sutuna sürekli veri girişi var a sutuna sicil yazdığımda listeye ilk defa yazılıyorsa ismi elle yazacagım fakaf listenin yukarısında daha önce yazılı ise a sutuna sicil yazdığımda karşısına b sutuna ismin otomatik yazmasını istiyorum.

 

[Necdet]

Merhaba.
Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.
1. satırın başlık olduğu varsayılmıştır.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A:A]) Is Nothing Or Target.Value = "" Then Exit Sub

Dim c As Range

Set c = Range("A2:A" & Target.Row - 1).Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
    Target.Offset(0, 1) = Range("B" & c.Row)
    Target.Offset(1, 0).Activate
Else
    Target.Offset(0, 1).Activate
End If

End Sub

 

[aligunes]

Merhaba.
Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.
1. satırın başlık olduğu varsayılmıştır.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A:A]) Is Nothing Or Target.Value = "" Then Exit Sub

Dim c As Range

Set c = Range("A2:A" & Target.Row - 1).Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
    Target.Offset(0, 1) = Range("B" & c.Row)
Else
    Target.Offset(0, 1).Activate
End If

End Sub

teşekkürler hocam

 

[Necdet]

teşekkürler hocam

Rica ederim, güle güle kullanınız, kodlarda küçük bir değişiklik yaptım, tekrar alınız.

 

[aligunes]

Rica ederim, güle güle kullanınız, kodlarda küçük bir değişiklik yaptım, tekrar alınız.

Necdet hocam emeğin için tsk ederim. veri isimli sayfada b3 sıradan başlayan b sutunda sicil var c unvan d isim soyisim var izin takip sekmesinde ise b sutuna sicil yazdigimda c ye unvan d sutuna da isim soy isim yazacak makro kodunu yazabilirmisiniz

 

[Necdet]

Merhaba,
Paylaşım sitelerinden birine küçük örnek bir dosyanızı eklerseniz gereksiz yazışmalardan ve veri hazırlamaktan kurtulmuş oluruz.

 

[aligunes]

Merhaba,
Paylaşım sitelerinden birine küçük örnek bir dosyanızı eklerseniz gereksiz yazışmalardan ve veri hazırlamaktan kurtulmuş oluruz.

@Necdet hocam dosya ekledim.

 

[Necdet]

Merhaba,
Aşağıdaki kodları "İzin Takip" sayfasının kod bölümüne kopyalayıp dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range

If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 3 Then Exit Sub
Set c = Sayfa1.Range("B:B").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
    Target.Offset(0, 1) = c.Offset(0, 1)
    Target.Offset(0, 2) = c.Offset(0, 2)
    Target.Offset(0, 3).Activate
End If

End Sub

 

[aligunes]

Merhaba,
Aşağıdaki kodları "İzin Takip" sayfasının kod bölümüne kopyalayıp dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range

If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 3 Then Exit Sub
Set c = Sayfa1.Range("B:B").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
    Target.Offset(0, 1) = c.Offset(0, 1)
    Target.Offset(0, 2) = c.Offset(0, 2)
    Target.Offset(0, 3).Activate
End If

End Sub

KOD ÇALIŞIYOR GÜZEL OLDU ELİNİZE SAĞLIK