Çift tık ile uyarı alma

[Yesilyurtlu]

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i, sat

If Intersect(Target, Range("c:c")) Is Nothing Then Exit Sub
Cancel = True
If Target.Cells = "" Then Exit Sub
sat = Worksheets("BORDRO").Cells(Rows.Count, "c").End(3).Row + 1
Sheets("BORDRO").Cells(sat, 1).Value = sat - 10
For i = 3 To 3
Sheets("BORDRO").Cells(sat, i).Value = Cells(Target.Row, i).Value
Next i
MsgBox "aktarma yapıldı"
End Sub


Bir Satıra birinci çift tıklanırken renginin Sarı
ikinci çift tıklamada da ikinci kez seçiyorsunuz aktarma yapılsın mı? uyarısını vemesini EVET ise aktarmanın yapılmasını HAYIR ise aktarmanın iptalini yukarıda kodları Halit Üstadıma ait koda ekleyebilir misiniz?

Teşekkür Ederim

 

[Ömer]

Bir Satıra birinci çift tıklanırken renginin Sarı
ikinci çift tıklamada da ikinci kez seçiyorsunuz aktarma yapılsın mı? uyarısını vemesini EVET ise aktarmanın yapılmasını HAYIR ise aktarmanın iptalini yukarıda kodları Halit Üstadıma ait koda ekleyebilir misiniz?

Teşekkür Ederim

Merhaba,

Bu şekilde deneyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    Dim sat As Long, sor As String
 
    If Intersect(Target, Range("c:c")) Is Nothing Then Exit Sub
    Cancel = True
 
    If Target.Cells = "" Then Exit Sub
 
    If Target.Interior.ColorIndex = 6 Then
        sor = MsgBox("İkinci kez seçiyorsunuz aktarma yapılsın mı?", vbYesNo, "Sonuc")
        If sor = vbNo Then Exit Sub
    End If
 
    Target.Interior.ColorIndex = 6
 
    With Sheets("BORDRO")
        sat = .Cells(Rows.Count, "C").End(xlUp).Row + 1
        .Cells(sat, "A").Value = sat - 10
        .Cells(sat, "C").Value = Cells(Target.Row, "C").Value
    End With
 
    MsgBox "aktarma yapıldı"
 
End Sub

Kodunuzda;

For i = 3 to 3

tek aralık olduğundan sadece C sütununu temsil eder bu yüzden döngü yerine sütun adı kullandım.

.

 

[Yesilyurtlu]

Ömer Abi
Ellerine Sağlık. Yardımınız için Teşekkür Ederim.
Allah Razı Olsun Abimden

 

[Ömer]

Rica ederim. Allah hepimizden razı olsun.