Döngüyü sonlandırma

[ileriexcel]

İki veri aralığında bir birine denk olan verileri buldurup ilgili hücrelerin bir sağına aldırmak istiyorum fakat döngü dönüp duruyor oysa aa40 'a geldiğinde durmalı.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
For Each bul In Range("AA20:AA40")
For Each bul2 In Range("AE20:AE39")
If bul.Value = bul2.Value Then
bul2.Offset(0, 1).Copy
bul.Offset(0, 1).PasteSpecial
End If
Next
Next
End Sub

 

[Levent Menteşoğlu]

Change olayına yazdığınız kod her paste olayından sonra tekrar tetiklendiğinden döngüyü her seferinde tekrar baştan başlatır. Kodunuza aşağıdaki mavi renkli satırları ilave edip deneyebilirsiniz. Yada döngünün çalışacağı aralığı intersect komutu ile kod başında tanımlayabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
[B][COLOR=blue]application.enableevents=false[/COLOR][/B]
On Error Resume Next
For Each bul In Range("AA20:AA40")
For Each bul2 In Range("AE20:AE39")
If bul.Value = bul2.Value Then
bul2.Offset(0, 1).Copy
bul.Offset(0, 1).PasteSpecial
End If
Next
Next
[COLOR=blue][B]application.enabledevents=true[/B][/COLOR]
End Sub

veya

Private Sub Worksheet_Change(ByVal Target As Range)
[B][COLOR=blue]if intersect(target,[aa:aa]) is nothing then exit sub
[/COLOR][/B]On Error Resume Next
For Each bul In Range("AA20:AA40")
For Each bul2 In Range("AE20:AE39")
If bul.Value = bul2.Value Then
bul2.Offset(0, 1).Copy
bul.Offset(0, 1).PasteSpecial
End If
Next
Next
End Sub

 

[ileriexcel]

Saygı değer leventm çok teşşekür ederim.