Hücre Değerindeki Tarihden Bugüne Tarih Sıralama

[akhsahbaz]

Arkadaşlar aradım ama bulamadım. Yardım istediğm kısaca,

Örneğin Sayfa1 de A3 e yazılan tarih Sayfa2 de A3 e kopyalanacak ve A3 deki tarihten bugüne kadar otomatik sıralayacak. Bu işlemi bir buton ile yapmak istiyorum. Şimdiden ilginiz ve yardımlarınız için teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub TARİH_AKTAR()
    If Sheets("Sayfa1").[A3] = "" Or Sheets("Sayfa1").[A3] > Date Then Exit Sub
    Satır = 3
    For X = Sheets("Sayfa1").[A3] To Date
    Sheets("Sayfa2").Cells(Satır, 1) = X
    Satır = Satır + 1
    Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[akhsahbaz]

Teşekkür ederim.

Sayın Cost_control teşekkür ederim. Denerken Giriş yaptığım tarihe dikkat etmemişim.

 

[Korhan Ayhan]

Selamlar,

Önerdiğim kod çalışıyor. Siz sorunuzda A3 hücresine yazılan tarihten bugüne sıralama yapılmasını istemişsiniz. Eklediğiniz örnek dosyada kullandığınız tarih bugünden büyük olduğundan kod çalışmıyor.

 

[akhsahbaz]

Arkadaşlar peki, Sayfa1 de A3 e yazılan tarih Sayfa2 de A4 e kopyalanacak ve A4 den A65536 ya kadar otomatik sıralayacak. Bu işlem Sayfa1 deki A3 hücresine tarih girildiğinde çalışabilir mi?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu Sayfa1 in kod bölümüne uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A3]) Is Nothing Then Exit Sub
    Set S2 = Sheets("Sayfa2")
    If Target <> "" Then
    S2.[A4] = Target
    S2.[A4].AutoFill Destination:=S2.[A4:A65536], Type:=xlFillDays
    End If
    Set S2 = Nothing
End Sub

 

[akhsahbaz]

Sn.Cost_Control yine hızır gibi yetiştiniz. İlginiz ve yardımınız öncelikle teşekkürler. Verdiğiniz kodu kendi çalışmamda çalıştıramadım.
"Private Sub Worksheet_Change(ByVal Target As Range)" yani ilk satırda hata veriyor. Sebebide muhtemelen aynı başlıkla başka bir kodun bulunması. Bunun için kodun normalde çalışıp çalışmadığını denetlemek için boş bir çalışma dosyasında denedim. Kod çalışıyor.