Hedef sütun birden çok olursa nasıl bir kod ekleriz?

[Araştırıcı]

Hedef sütun birden çok olursa nasıl bir kod ekleriz?

Sayın Değerli Uzmanlarım,

Daha önce Sayın Değerli Ripek ile yapılan çalışma sonrası gönderilen linkten bir çalışma çıkarmaya çalıştım. Target (N:N) için sorun olmadan olayı çözdük. Ancak Target hem N Sütunu hemde U sütunu olursa aşağıdaki gibi bir başlangıç olabilir mi, ya da kodları nasıl revize etmemiz gerekir.
Birden çok Target sütunu ile çalışacaksa olayın mantığı ne olmalı?
Sizin yönlendirmenize göre oluşturmaya çalıştığım kodlar aşağıdadır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim s1, s2, s3, S4 As Object
If Intersect(Target, [N:N], [U:U]) Is Nothing Then Exit Sub
Cancel = True
Set s1 = Sheets("aktarılan işler")
If Target.Value = "SP1" Then
Set s2 = Sheets("SP1")
sat = s2.[b65536].End(3).Row + 1
s2.Cells(sat, "b").Value = sat - 1
s2.Range(s2.Cells(sat, "b"), s2.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set s2 = Nothing
ElseIf Target.Value = "SP2" Then
Set s3 = Sheets("SP2")
sat = s3.[b65536].End(3).Row + 1
s3.Cells(sat, "b").Value = sat - 1
s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set s3 = Nothing
ElseIf Target.Value = "SP3" Then
Set s3 = Sheets("SP3")
sat = s3.[b65536].End(3).Row + 1
s3.Cells(sat, "b").Value = sat - 1
s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set s3 = Nothing
ElseIf Target.Value = "PARAKENDE" Then
Set s3 = Sheets("PARAKENDE")
sat = s3.[b65536].End(3).Row + 1
s3.Cells(sat, "b").Value = sat - 1
s3.Range(s3.Cells(sat, "b"), s3.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set s3 = Nothing

ElseIf Target.Value = "OLUMSUZ" Then
Set S4 = Sheets("OLUMSUZ")
sat = S4.[b65536].End(3).Row + 1
S4.Cells(sat, "b").Value = sat - 1
S4.Range(S4.Cells(sat, "b"), S4.Cells(sat, "v")).Value = s1.Range(s1.Cells(Target.Row, "b"), s1.Cells(Target.Row, "v")).Value
Set S4 = Nothing

Else
Exit Sub
End If
Target.Offset(1, 0).Select
Set s1 = Nothing
End Sub

 

[Seyit Tiken]

Örnek kodu uyarlayınız.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [U:U,N:N]) Is Nothing Then Exit Sub
MsgBox "seyit"
End Sub

 

[Araştırıcı]

Sayın Seyit TİKEN,
Çok teşekkür ediyorum. Kodları deneyerek çalışmayı tamamlayacağım. Bu konuda bir sorunla karşılaşırsam, başlamış olan çalışmayı nihayi hale getirme adına size geri dönebilir miyim?

 

[Seyit Tiken]

Ben sadece görüşümü söylüyorum. Eğer sorulan soruya cevap gelmiyorsa yada geç cevap veriliyorsa, soru sorma yöntemini sorgulamak gerek, diye düşünüyorum. Soruyu kalabalık bir şekilde yada birden fazla soruyu tek seferde sorulduğu zaman, şahsen kafam karışıyor ve ister istemez insan soruya yönelemiyor. Onun için soru ne kadar net ve kısa olursa, hem cevaplar hızlı gelir hemde farklı cevaplar gelir. İnan ki; şu anda gelen sorular için hepimiz pusuda bekliyoruz. Yeter ki soru net ve açıklayıcı olsun.