Tarihe Göre Otomatik Sıralamalı

[ramazankar]

Selam

Siz değerli hocalarımdan yardım istemekteyim

1.- Excelde bir tablo yaptım. Bu tabloda tarihe göre otomatik sıralama nasıl yaptırabilirim.
Örneğin 16.03.2025 e kadar tarih sırasına göre verileri girdim. Ama atlamış olduğum veya gözden kaçmış olan bir tarihte ör. 22.11.2024 tarihli verileri girdiğimde enter dediğimde otomatik olarak tüm verileri tarih sıraması nasıl yaptırabilirim.

2.- ortalama 55 veri girildiğinde yazdırma A4 sayfasına sağacak şekilde ikinci sayfada ilk sayfadaki toplam tutar yeni sayfanın başında olacak şekilde diğer sayfalara devam edecek nasıl devam ettirebilirim.

Teşekkürler

Ornek

 

[pitchoute]

Merhaba, ilk sorunuz için;

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo HataKontrol
    Dim tarihSutunu As String
    tarihSutunu = "A:A"  ' Kendi tarih sütununuza göre değiştirin
    
    Dim tabloBaslangic As String
    Dim tabloBitis As String
    tabloBaslangic = "A2" 
    tabloBitis = "E1000" 
    
    Application.EnableEvents = False
    
    If Not Intersect(Target, Range(tarihSutunu)) Is Nothing Then
        Range(tabloBaslangic & ":" & tabloBitis).Sort _
            Key1:=Range(tarihSutunu), _
            Order1:=xlAscending, _
            Header:=xlYes
    End If
    
HataKontrol:
    Application.EnableEvents = True
End Sub

İkinci sorunuz için;

Sub YazdirmaDuzeniAyarla()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    With ws.PageSetup
        .Orientation = xlPortrait
        .Zoom = False
        .FitToPagesWide = 1       
        .FitToPagesTall = False   
        .LeftHeader = ""
        .CenterHeader = "&""Arial""&12Sayfa &P / &N"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&""Arial""&12Toplam: " & Range("ToplamHucresi").Value
        .LeftMargin = Application.CentimetersToPoints(1.5)
        .RightMargin = Application.CentimetersToPoints(1.5)
        .TopMargin = Application.CentimetersToPoints(2)
        .BottomMargin = Application.CentimetersToPoints(2)
        .PrintTitleRows = "$1:$1"
    End With
End Sub