Worksheet_Change Altında üç işlem çalıştırma

[atillaciftci]

If Intersect(Target, [D12]) Is Nothing Then Exit Sub 'HÜCRE DEĞİŞİNCE MAKRO ÇALIŞSIN
Call SORGULA 'HÜCRE DEĞİŞİNCE MAKRO ÇALIŞSIN

Worksheet_Change Altında Yukardaki Hücre değişince Makronun çalışması , Mükerrer kayıt önleyici ve UserForm1 in açılması işlemini çalıştırmak istiyorum yukarıdaki kodu aşağıdakiler ile nasıl birleştirebilirim....??


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect ' Mükerrer kayıtı önler
For a = [b65536].End(3).Row To 1 Step -1 ' Mükerrer kayıtı önler
If WorksheetFunction.CountIf(Range("b25:b" & a), Cells(a, "b")) > 1 Then Rows(a).Delete ' Mükerrer kayıtı önler
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True ' Mükerrer kayıtı önler
On Error Resume Next ' Mükerrer kayıtı önler

If Intersect(Target, Range("b25:b100")) Is Nothing Then Exit Sub ' UserForm Aç
On Error Resume Next ' UserForm Aç
UserForm1.Show ' UserForm Aç

Exit Sub
Next
End Sub

 

[leumruk]

Merhaba,

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [D12]) Is Nothing Then 'HÜCRE DEĞİŞİNCE MAKRO ÇALIŞSIN
Call SORGULA 'HÜCRE DEĞİŞİNCE MAKRO ÇALIŞSIN
End If

If Not Intersect(Target, Range("b25:b100")) Is Nothing Then ' UserForm Aç
ActiveSheet.Unprotect ' Mükerrer kayıtı önler
For a = [b65536].End(3).Row To 1 Step -1 ' Mükerrer kayıtı önler
If WorksheetFunction.CountIf(Range("b25:b" & a), Cells(a, "b")) > 1 Then Rows(a).Delete ' Mükerrer kayıtı önler
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True ' Mükerrer kayıtı önler
On Error Resume Next ' Mükerrer kayıtı önler
UserForm1.Show ' UserForm Aç
Exit Sub
Next
End Sub

 

[atillaciftci]

Yazdığının sonuna sadece End if eklememi istedi ekledim ve çalışıyor süpersin teşekkürler..