Hücreye çift tıklama ile kopyala yapıştır kodunda yardım

[kemal turan]

Aşağıdaki C sutununda çift tıklayarak kopyala yapıştır kodunda 1 nci kod çalışıyor.
Fakat bu olayı kopyalayıp D sutunu için yapmaya çalıştığımda çalışmıyor.
2 nci kodda neyi değiştirmemiz veya eklememiz lazım
Teşekkürler
1nci kod
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("c80:c20000")) Is Nothing Then Exit Sub
Selection.Copy
Range("c7").PasteSpecial Paste:=xlPasteValues
End Sub

2 nci kod
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("D8020000")) Is Nothing Then Exit Sub
Selection.Copy
Range("c6").PasteSpecial Paste:=xlPasteValues
End Sub

 

[ynmcan]

Aşağıdaki C sutununda çift tıklayarak kopyala yapıştır kodunda 1 nci kod çalışıyor.
Fakat bu olayı kopyalayıp D sutunu için yapmaya çalıştığımda çalışmıyor.
2 nci kodda neyi değiştirmemiz veya eklememiz lazım
Teşekkürler
1nci kod
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("c80:c20000")) Is Nothing Then Exit Sub
Selection.Copy
Range("c7").PasteSpecial Paste:=xlPasteValues
End Sub

2 nci kod
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("D8020000")) Is Nothing Then Exit Sub
Selection.Copy
Range("c6").PasteSpecial Paste:=xlPasteValues
End Sub

Syn. Kemal TURAN;
yazdığınız kod çalışıyor.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("D80:D20000")) Is Nothing Then Exit Sub
Selection.Copy
Range("c6").PasteSpecial Paste:=xlPasteValues
End Sub

Ancak siz iki kodu da çalıştırmak istiyorsanız aşağıdaki gibi kullanın.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Range("c80:d20000")) Is Nothing Then Exit Sub

If Intersect(Target, Range("c80:c20000")) Is Nothing Then
Selection.Copy
Range("c6").PasteSpecial Paste:=xlPasteValues
End If

If Intersect(Target, Range("d80:d20000")) Is Nothing Then
Selection.Copy
Range("c7").PasteSpecial Paste:=xlPasteValues
End If

End Sub

Örnek dosyayı inceleyin.

 

[kemal turan]

Şunu anladım;""Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)"" bir defa kodun başında kullanılması gerekiyor.
Çok teşekkür ederim.
Selametle kalın

 

[kemal turan]

merhaba,
Çift tıkalama ile kopyala yapıştır formülünü 3 veriyi içerecek şekilde revize etmeye çalıştım, başaramadım.
Dosya ekleyemedim.
BU KOD SORUNSUZ ÇALIŞIYOR..
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("B18:C20000")) Is Nothing Then Exit Sub
If Intersect(Target, Range("B18:B20000")) Is Nothing Then
Selection.Copy
Range("c6").PasteSpecial Paste:=xlPasteValues
End If
If Intersect(Target, Range("C18:C20000")) Is Nothing Then
Selection.Copy
Range("c7").PasteSpecial Paste:=xlPasteValues
End If
End Sub

REVİZE ETMEYE ÇALIŞTIĞIM AŞAĞIDAKİ KOD KARIŞTIRIYOR
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("B1820000")) Is Nothing Then Exit Sub
If Intersect(Target, Range("B18:B20000")) Is Nothing Then
Selection.Copy
Range("c6").PasteSpecial Paste:=xlPasteValues
End If
If Intersect(Target, Range("C18:C20000")) Is Nothing Then
Selection.Copy
Range("c7").PasteSpecial Paste:=xlPasteValues
End If
If Intersect(Target, Range("D1820000")) Is Nothing Then
Selection.Copy
Range("c4").PasteSpecial Paste:=xlPasteValues
End If
End Sub
Yanlışım nerede acaba yardımcı olabilirmisiniz ?

Teşekkürler.

 

[kemal turan]

gülümseme ikonu çıkan yerde "d" sutunu yazıyor

 

[kemal turan]

Dosyayı ekleyebildim.
Teşekkür ederim.