Makro Otomatik Çalıştırma

[katip06]

Üstadlar kolay gelsin, aşağıdaki makromun BİGM DİZÜSTÜ ENVANTER sayfasında A2:A1500 arasına veri girişi yaptığımda çalışmasını istiyorum, bulduğum örnekleri uyguladım fakat çalışmadı, yardımcı olabilir misiniz?

Sub DuseyaraTümü()
With Sheets("BİGM DİZÜSTÜ ENVANTER").Range("B2:B5000")
.FormulaLocal = "=EĞERHATA(DÜŞEYARA(A2;'BİGM PERSONEL'!$B:$C;2;0);"""")"
.Value = .Value
Module2.DuseyaraTC
Module2.DuseyaraUnvan

End With
End Sub

 

[YUSUF44]

Asıl yapmak istediğinizi örnek dosyayla gösterin lütfen.

 

[katip06]

Asıl yapmak istediğinizi örnek dosyayla gösterin lütfen.

Yusuf Hocam BİGM DİZÜSTÜ ENVANTER sayfasında A2'den itibaren sicil girdiğimde BİGM PERSONEL sayfasından Adını, Ünvanını ve TC Kimlik Numarasını çekiyor düşeyara makrosu ile, bu makro da şu anda düğmeye bağlı çalışıyor, benim istediğim A2:A1500 hücrelerinden herhangi birine giriş yaptığımda düşeyara makrosunun otomatik çalışması, teşekkür ederim.

 

[YUSUF44]

Modüldeki makroya gerek yok, envanter sayfasının kod bölümündeki kodları aşağıdakilerle değiştirin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I2:I1500")) Is Nothing Then GoTo 10
laptopDepo
10:
If Intersect(Target, Range("A2:A1500")) Is Nothing Then Exit Sub
If Target = "" Then
    Target.Offset(0, 1).ClearContents
    Target.Offset(0, 2).ClearContents
    Target.Offset(0, 3).ClearContents
    Exit Sub
End If
Set s1 = Sheets("BİGM PERSONEL")
son = s1.Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(s1.Range("B1:B" & son), Target) = 0 Then
    MsgBox "Personel sayfasında " & Target & " sicil numarallı personel bulunamadı!", vbInformation
    Target.Offset(0, 1).ClearContents
    Target.Offset(0, 2).ClearContents
    Target.Offset(0, 3).ClearContents
Else
    Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, s1.Range("B1:G" & son), 2, 0)
    Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, s1.Range("B1:G" & son), 4, 0)
    Target.Offset(0, 3) = WorksheetFunction.VLookup(Target, s1.Range("B1:G" & son), 5, 0)
End If
End Sub

 

[katip06]

Modüldeki makroya gerek yok, envanter sayfasının kod bölümündeki kodları aşağıdakilerle değiştirin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I2:I1500")) Is Nothing Then GoTo 10
laptopDepo
10:
If Intersect(Target, Range("A2:A1500")) Is Nothing Then Exit Sub
If Target = "" Then
    Target.Offset(0, 1).ClearContents
    Target.Offset(0, 2).ClearContents
    Target.Offset(0, 3).ClearContents
    Exit Sub
End If
Set s1 = Sheets("BİGM PERSONEL")
son = s1.Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(s1.Range("B1:B" & son), Target) = 0 Then
    MsgBox "Personel sayfasında " & Target & " sicil numarallı personel bulunamadı!", vbInformation
    Target.Offset(0, 1).ClearContents
    Target.Offset(0, 2).ClearContents
    Target.Offset(0, 3).ClearContents
Else
    Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, s1.Range("B1:G" & son), 2, 0)
    Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, s1.Range("B1:G" & son), 4, 0)
    Target.Offset(0, 3) = WorksheetFunction.VLookup(Target, s1.Range("B1:G" & son), 5, 0)
End If
End Sub

Çok sağol Yusuf44 hocam, teşekkür ederim.

 

[YUSUF44]

Bu vesileyle örnek dosyanın önemini tekrar hatırlatır, bundan sonraki sorularınızı örnek dosyayla desteklemenizi tavsiye ederim.