Sıralama

[ormann]

Sayın arkadaşlar aşağıdaki koda nasıl bir makro uygulamalıyız ki verileri otamatik olarak tarihe göre tüm satırı sıralama yaptırmaliyız.


Sub Bugun()
Dim s, Dosya_Yolu As String
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L65536").ClearContents
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "BY").Value, "dd.mm.yyyy")
bb = Format(Date, "dd.mm.yyyy")
If aa = bb Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "BY").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
Sheets("DURUŞMALAR").Select
ActiveWindow.SelectedSheets.PrintPreview
Sheets("DETAYLI DAVA TAKİP").Select
End Sub

 

[uzmanamele]

merhaba

bunu deneyiniz.

Sub Bugun()
Dim s, Dosya_Yolu As String
Set s1 = Sheets("SUÇ KAYDI")
Set s2 = Sheets("DURUŞMALAR")
s2.Select
s2.Range("A2:L65536").ClearContents
s1.Select
For i = 2 To s1.Range("A65536").End(3).Row
aa = Format(s1.Cells(i, "BY").Value, "dd.mm.yyyy")
bb = Format(Date, "dd.mm.yyyy")
If aa = bb Then
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(sonsat, "A").Value = s1.Cells(i, "BY").Value
s2.Cells(sonsat, "B").Value = s1.Cells(i, "A").Value
s2.Cells(sonsat, "C").Value = s1.Cells(i, "B").Value
s2.Cells(sonsat, "D").Value = s1.Cells(i, "C").Value
s2.Cells(sonsat, "E").Value = s1.Cells(i, "D").Value
s2.Cells(sonsat, "F").Value = s1.Cells(i, "E").Value
s2.Cells(sonsat, "G").Value = s1.Cells(i, "F").Value
s2.Cells(sonsat, "H").Value = s1.Cells(i, "Q").Value
s2.Cells(sonsat, "I").Value = s1.Cells(i, "AR").Value
s2.Cells(sonsat, "J").Value = s1.Cells(i, "BW").Value
s2.Cells(sonsat, "K").Value = s1.Cells(i, "BX").Value
s2.Cells(sonsat, "L").Value = s1.Cells(i, "AP").Value
End If
Next
Sheets("DURUŞMALAR").Select
    Columns("A:A").Select
    ActiveWorkbook.Worksheets("DURUŞMALAR").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DURUŞMALAR").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DURUŞMALAR").Sort
        .SetRange Range("A2:A65536")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
ActiveWindow.SelectedSheets.PrintPreview
Sheets("DETAYLI DAVA TAKİP").Select
End Sub

örnek dosya ekleseydiniz kodun çalıştığını test etme imkanı olurdu.

 

[ormann]

Sayın Hocam kodda hata verdi