Makro ile Aktif hücrede Düşeyara

[Okyanus101]

Değerli arkadaşlar.
Sorunum şu kodlar.

Private Sub Worksheet_change(ByVal target As Range)
[COLOR=green]'On Error Resume Next[/COLOR]
If Intersect(target, [a:a]) Is Nothing Then Exit Sub
frm = Sheets("sayfa2").[m2:n2000]
 
[COLOR=green]'For i = 9 To [a65536].End(3).Row[/COLOR]
[COLOR=green]'Range("b" & i) = WorksheetFunction.VLookup(Range("a" & i), frm, 2, 0)[/COLOR]
[COLOR=green]'If Range("a" & i) = "" Then Range("b" & i) = ""[/COLOR]
[COLOR=green]'Next[/COLOR]
 
[COLOR=blue]sat = ActiveCell.Row[/COLOR]
[COLOR=blue]Range("b" & sat) = WorksheetFunction.VLookup(Range("a" & sat), frm, 2, 0)[/COLOR]
End Sub

Yeşil kısmı aktif edip mavi kısmı silince işlemi yapıyorum. Yalnız tüm sütunu hesapladığı için işlem süresi uzuyor.
Yapmak istediğim "A" sütununda hangi hücre aktif olursa Vlookup o satırda çalışsın.

Saygılar sunarım.

 

[Orion1]

merhaba.
Aşağıdaki şekilde denermisiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim frm As Range
On Error Resume Next
If Intersect(Target, [a:a]) Is Nothing Then Exit Sub
Set frm = Sheets("sayfa2").[m2:n2000]
sat = Target.Row
range("B" & sat).value=ClearContents
Range("b" & sat) = WorksheetFunction.VLookup(Range("a" & sat), frm, 2, 0)
End Sub

 

[Okyanus101]

Sn. Sezar
Deneyeceğim. Ama, ancak hafta içi dönebilirim.
Siz ve ilgilenen tüm arkadaşlara teşekkür ederim.

 

[Recep İpek]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A9:A5000]) Is Nothing Then Exit Sub
Set frm = Sheets("sayfa2").[m2:n2000]
    Target.Offset(0, 1).ClearContents
    Target.Offset(0, 1).Value = WorksheetFunction.VLookup(Target.Value, frm, 2, 0)
End Sub

deneyiniz.

Bu şekilde bulunmayan kayıtlarda b kolunu boş kalacaktır.