ana arşive aktar

[cems]

Ekte bulunan dosyada ;

Arşiv kaydı adlı sayfada satırın solunda bulunan boş hücreye çift tıklandığında, o satır hücre hücre 1 adlı sayfaya başlık altına aşağıdaki kodlar ile aktarılıyor.

Bu işlemin genel amacı değişebilen arşiv kaydı sayfalarını sabit bir sayfaya bir ay ya da sene boyunca listeletmek...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sayfa As String
If Not Intersect(Target, Range("A4:A16")) Is Nothing Then
sayfa = "1"
ElseIf Not Intersect(Target, Range("A4:A28")) Is Nothing Then
sayfa = "ARŞİV KAYDI"
Else
Exit Sub
End If



Sheets(sayfa).Range("b4").Value = Target.Offset(0, 1).Value
Sheets(sayfa).Range("c4").Value = Target.Offset(0, 2).Value
Sheets(sayfa).Range("d4").Value = Target.Offset(0, 3).Value
Sheets(sayfa).Range("e4").Value = Target.Offset(0, 4).Value
Sheets(sayfa).Range("f4").Value = Target.Offset(0, 5).Value
Sheets(sayfa).Range("g4").Value = Target.Offset(0, 6).Value
Sheets(sayfa).Range("h4").Value = Target.Offset(0, 7).Value
Sheets(sayfa).Range("i4").Value = Target.Offset(0, 8).Value
Sheets(sayfa).Range("j4").Value = Target.Offset(0, 9).Value
Sheets(sayfa).Range("k4").Value = Target.Offset(0, 10).Value
Sheets(sayfa).Range("l4").Value = Target.Offset(0, 11).Value
Sheets(sayfa).Range("m4").Value = Target.Offset(0, 12).Value
Sheets(sayfa).Range("n4").Value = Target.Offset(0, 13).Value
Sheets(sayfa).Range("o4").Value = Target.Offset(0, 14).Value

MsgBox "Bu satır aktarıldı"

End Sub

İstenen 3 konu :

1- Çift tıklanan sol boş hücreye otomatik X işareti konması
2- Taşınan satırın 1 adlı sayfada eskisinin üzerine değil ilk boş satıra kaydedilmesi
3- 1 sayfasında c4:c65000 arasında mükerrer varsa kaydın yine de yapılması ama uyarı
açılması ve 1 adlı sayfadaki mükerrerin satır no sunu uyarıda vermesi

Bu üç işlem için verilen kodlarda nasıl bir düzeltme gerekir ?