her sayfaya göre izinli aktarma

[sirkülasyon]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim s1, s2, s3, s4, S5, S6  As Worksheet
 Set s4 = Sheets("HİZİŞLHAKRAP")
  Set s3 = Sheets("BORDRO")
    Set S5 = Sheets("HAKEDİŞRAPORU")
        Set S6 = Sheets("HAKÖDEMEİCMALİ")
           Set s2 = Sheets("Bilgi Girişi")
            Set s1 = Sheets("Yetkili")
--------------------------------------------------

s3.Cells(3, 5) = Target.Offset(0, 8)
s4.Cells(11, 4) = Target.Offset(0, 52)
s5.Cells(9, 9) = Target.Offset(0, 9)
s6.Cells(10, 4) = Target.Offset(0, 27)
s7.Cells(13, 4) = Target.Offset(0, 2)

Müsaadenizle sorum şu:
Doubleclick ile ilk aktarım yapılmış. Sehven ikinci "mükerrer" aktarım yapıldığı an tekrar s3, s4, s5, s6, s7 gibi değişik değişik sayfalara aktarma yapacak.
Ben istiyorum ki, kullanıcıya sorsun.
Mükerrer aktarma yapmaya çalışıyorsunuz. İzniniz gerekli
s3 aktarayım mı?
Evet Hayır
s4 aktarayım mı?
Evet Hayır
s5 aktarayım mı?
Evet Hayır
s6 aktarayım mı?
Evet Hayır
s7 aktarayım mı?
Evet Hayır
Evet seçilenler aktarılsın, Hayır seçilenler aktarılmasın.
Mümkün müdür?
Teşekkür Ederim

 

[PLİNT]

Merhaba
Aşağıdaki gibi deneyin.

[SIZE="2"]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim s1, s2, s3, s4, S5, S6  As Worksheet
 Set s4 = Sheets("HİZİŞLHAKRAP")
  Set s3 = Sheets("BORDRO")
    Set S5 = Sheets("HAKEDİŞRAPORU")
        Set S6 = Sheets("HAKÖDEMEİCMALİ")
           Set s2 = Sheets("Bilgi Girişi")
            Set s1 = Sheets("Yetkili")
If MsgBox(s3.Name & " Sayfasına aktarım yapılsınmı?", vbYesNo) = vbYes Then _
s3.Cells(3, 5) = Target.Offset(0, 8)
If MsgBox(s4.Name & " Sayfasına aktarım yapılsınmı?", vbYesNo) = vbYes Then _
s4.Cells(11, 4) = Target.Offset(0, 52)
If MsgBox(S5.Name & " Sayfasına aktarım yapılsınmı?", vbYesNo) = vbYes Then _
S5.Cells(9, 9) = Target.Offset(0, 9)
If MsgBox(S6.Name & " Sayfasına aktarım yapılsınmı?", vbYesNo) = vbYes Then _
S6.Cells(10, 4) = Target.Offset(0, 27)
If MsgBox(s7.Name & " Sayfasına aktarım yapılsınmı?", vbYesNo) = vbYes Then _
s7.Cells(13, 4) = Target.Offset(0, 2)
End Sub [/SIZE]

 

[sirkülasyon]

Sayın Plint Ellerine Sağlık. Teşekkür Ederim. Makro çalışıyor.
Ancak mükerrer aktarım kontrolü yoktur.
İlk aktarımda sormayacak. İkinci aktarımda
"Mükerrer aktarma yapmaya çalışıyorsunuz. İzniniz gerekli" gibi uyarı verecek