Verileri Sayfa2 ye Sıralı Aktarma

[Mustafa MUTLU]

Yardımlarınız için Teşekkür ederim.

Ekte verdiğim dosyada gerekli açıklamayı yaptım.

Ürünleri girdiğimizde sayfa2 de kendine uygun yere kayıt edecek..

 

[Orion1]

Dosyanız ektedir.
Çift tıklama ile çalışır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim k As Range
If Intersect(Target, Range("C3:S" & Cells(65536, "C").End(xlUp).Row)) Is Nothing Then Exit Sub
Cancel = True
Set k = Sheets("Sayfa2").Range("A3:A" & Sheets("Sayfa2").Cells(65536, "A") _
.End(xlUp).Row).Find(hafta_basi(Date), , xlValues, xlWhole)
If k Is Nothing Then
    sat = Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row + 1
    Else
    sat = k.Row
End If
Sheets("Sayfa2").Cells(sat, Target.Value + 1).Value = 1
End Sub