DaubleClick kullanımı

[igultekin2000]

iyi günler oluşan raporda bana gereken kısmı AKTAR sayfasında biriktirmek istiyorum. başka işlemlerde kullandığım makroyu adapte etmek istedim, yapamadım.
HAREKET sayfasındaki I sütunundaki hücreye çift tıkladığımda - H ve I - hücresini AKTAR sayfasındaki " A ve B " hücresine, L hücresine çift tıklandığında " J ve L " hücresini AKTAR sayfasındaki " D ve E " hücresine aktarılmasına çalıştım.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("L2:L65536")) Is Nothing Then Exit Sub
Range(Cells(Target.Row, 1), Cells(Target.Row, 12)).Copy Sheets("AKTAR").[L65536].End(xlUp).Offset(1, -11)

Cancel = True
End Sub

 

[askm]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("I2:I65536")) Is Nothing Then
son = Sheets("AKTAR").Range("A" & Rows.Count).End(3).Row + 1
Range(Cells(Target.Row, "H"), Cells(Target.Row, "I")).Copy
Sheets("AKTAR").Range("A" & son).PasteSpecial xlPasteValues
End If


If Intersect(Target, Range("L2:L65536")) Is Nothing Then Exit Sub
son = Sheets("AKTAR").Range("D" & Rows.Count).End(3).Row + 1
Range(Cells(Target.Row, "J"), Cells(Target.Row, "L")).Copy
Sheets("AKTAR").Range("D" & son).PasteSpecial xlPasteValues
End Sub

 

[igultekin2000]

Sorunsuz çalışıyor

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("I2:I65536")) Is Nothing Then
son = Sheets("AKTAR").Range("A" & Rows.Count).End(3).Row + 1
Range(Cells(Target.Row, "H"), Cells(Target.Row, "I")).Copy
Sheets("AKTAR").Range("A" & son).PasteSpecial xlPasteValues
End If


If Intersect(Target, Range("L2:L65536")) Is Nothing Then Exit Sub
son = Sheets("AKTAR").Range("D" & Rows.Count).End(3).Row + 1
Range(Cells(Target.Row, "J"), Cells(Target.Row, "L")).Copy
Sheets("AKTAR").Range("D" & son).PasteSpecial xlPasteValues
End Sub

çok teşekkür ederim, sorunsuz çalışıyor, iyi çalışmalar.

 

[askm]

Rica ederim. Kolay gelsin.