SelectionChange de 2 ayrı tetikleme

[mersilen]

Merhabalar
SelectionChange de 2 ayrı tetikleme nasıl yapılır

örneğin

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
If Intersect(Target, [C20:C2000,w20:w2000]) Is Nothing Then Exit Sub
Cells(Target.Row, 27) = 1

If Intersect(Target, [b20:b2000]) Is Nothing Then Exit Sub
Cells(Target.Row, 27) = 55

End Sub

 

[Ömer]

Merhaba,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    If Intersect(Target, [B20:C2000,w20:w2000]) Is Nothing Then Exit Sub
 
    With Target
        If .Column = 2 Then
            Cells(.Row, 27) = 55
        Else
            Cells(.Row, 27) = 1
        End If
    End With
 
End Sub

Bu şekilde yazabilirsiniz.

.

 

[Huseyinkis]

Alternatif

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
If Intersect(Target, [C20:C2000,w20:w2000]) Is Nothing Then [B]Goto Adım2:[/B]
Cells(Target.Row, 27) = 1

[B]Adım2:[/B]
If Intersect(Target, [b20:b2000]) Is Nothing Then Exit Sub
Cells(Target.Row, 27) = 55

End Sub

 

[mersilen]

Arkadaşlar teşekkür
Ömer bey sizin kod çalışıyor, elseden sonra kod 2 (call sub aktar) ile çalıştırıp, target.row ları kod 2 ye aldırabilirmiyiz?
Hüseyin bey sizin kodu deneyeceğim

Amacım 2 kodu birleştirmek
1 kodda b sütununu seçersem kod 2 yi çalıştırıp hücrelerdeki satırı target.row olarak alması ve dosyayı kayıt etmesi
Tercihan dosya aynı klasör dizininin içine kayıt edilirse iyi olur

Private Sub Worksheet_SelectionChange1(ByVal Target As Range)
  
If Intersect(Target, [C20:C2000,w20:w2000]) Is Nothing Then Exit Sub
 
say = WorksheetFunction.Match(CDbl(Date), Rows(1), 0)
 
With Cells(Target.Row, say)
    .Value = Format(Now, "hh")
    .Interior.ColorIndex = 3
End With

With Cells(Target.Row, say)
    .Value = Format(Now, "hh")
    .Interior.ColorIndex = 3
End With

Application.ThisWorkbook.FollowHyperlink Address:="b.kor\" & Cells(Target.Row, "D").Value & ".html"
  
  End Sub

Option Explicit
Sub aktar()
Dim klasor, dosyaadi, i, a, b, c, d, e
klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")
dosyaadi = Worksheets("Sayfa1").Cells(41, 4)

Worksheets("Txt Dosyası").Cells(42, 1) = "<input type=" & """hidden""" & " name=" & """schiff[2]""" & " value=" & """" & Worksheets("Sayfa1").Cells(41, 96).Value & """" & ">"
Worksheets("Txt Dosyası").Cells(43, 1) = "<input type=" & """hidden""" & " name=" & """schiff[14]""" & " value=" & """" & Worksheets("Sayfa1").Cells(41, 95).Value & """" & ">"

If dosyaadi = "" Then
MsgBox "Dosya adı boş olamaz"
Exit Sub
End If
Open klasor & "\" & dosyaadi & ".html" For Output As #1
For i = 1 To Worksheets("Txt Dosyası").Cells(Rows.Count, "a").End(3).Row
a = Worksheets("Txt Dosyası").Cells(i, 1).Value & " "
b = Worksheets("Txt Dosyası").Cells(i, 2).Value & " "
c = Worksheets("Txt Dosyası").Cells(i, 3).Value & " "
d = Worksheets("Txt Dosyası").Cells(i, 4).Value & " "
e = Worksheets("Txt Dosyası").Cells(i, 5).Value
Print #1, a & b & c & d & e
Next i
MsgBox dosyaadi & "  Dosyası masa üstüne kayıt edildi"
Close #1
End Sub

Kod 2 nin içinde istediğim yerleri renklendirme yapamadığım için aşağıya ekledim (1 koddan gelen target.row olacak yerler)

klasor = CreateObject("wscript.Shell").SpecialFolders.Item("Desktop")
dosyaadi = Worksheets("Sayfa1").Cells(41, 4)

Worksheets("Txt Dosyası").Cells(42, 1) = "<input type=" & """hidden""" & " name=" & """schiff[2]""" & " value=" & """" & Worksheets("Sayfa1").Cells(41, 96).Value & """" & ">"
Worksheets("Txt Dosyası").Cells(43, 1) = "<input type=" & """hidden""" & " name=" & """schiff[14]""" & " value=" & """" & Worksheets("Sayfa1").Cells(41, 95).Value & """" & ">"