45 den küçükleri aktar

[polis-53]

Merhaba arkadaşlar aşağıdaki kodda nasıl bir değişiklik yapmam lazim ki
G sütununda 45 den kücükleri aktarabilirim.
bu kod G sütununda en büyük tarihi aktarıyor.

Sub SonListele()
Set sv = Sheets("vardiya")
Set sl = Sheets("Liste")
Dim i As Long
i = [A65536].End(3).Row
sl.Cells.ClearContents
sv.Range("A1:G" & i).Copy sl.[A1]

sl.Select
Application.ScreenUpdating = False

Range("A2:G" & i).Sort Key1:=[A2], Order1:=xlAscending, Key2:=[G2], Order2:=xlDescending

For i = i To 3 Step -1
If Cells(i, "A") = Cells(i - 1, "A") Then Rows(i).Delete
Next i


End Sub

 

[Korhan Ayhan]

"G" sütununda tarih varsa nasıl 45'ten küçük olacak?

Örnek dosyanız varsa ona göre kod yazılabilir.

 

[polis-53]

Merhaba korhan bey
dosya yolu
http://s3.dosya.tc/server13/h0z119/45_Yas_Calisma.xlsx.html

 

[YUSUF44]

Aşağıdaki makroyu bir modüle kopyalayıp deneyiniz. Öncesinde Sayfa1'in ilk 4 satırını sayfa2'nin ilk 4 satırına kopyalayınız:

Sub BES()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
eski = WorksheetFunction.Max(5, s2.Cells(Rows.Count, "A").End(3).Row)
s2.Range("A5:G" & eski) = ""
son = WorksheetFunction.Max(5, s1.Cells(Rows.Count, "A").End(3).Row)
For i = 5 To son
    If s1.Cells(i, "G") * 1 < 45 Then
        yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
        s1.Range("A" & i & ":G" & i).Copy s2.Cells(yeni, "A")
    End If
Next
End Sub

 

[polis-53]

Teşekkürler yusuf bey
iki yaş arasınıda aktarabilirmiyiz

 

[YUSUF44]

Elbette olur ancak bunun için hangi iki yaş olduğu önemlidir.

< 45

Yerine

<45 and >25

Derseniz 25'ten büyük 45'ten küçük olanları aktarır.