• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tarihi yaklaşan satırları başka sayfaya çekme

Katılım
24 Eylül 2010
Mesajlar
6
Excel Vers. ve Dili
2007 tr
Merhaba arkadaşlar bir hosting domain takip listesi yapıyorum
kendime göre bişeyler yaptım.

1. sayfada sadece süresi biten ve yaklaşmakta olanları listeletmek istiyorum tüm diğer bilgileriyle beraber ama beceremedim nasıl yapacağım konusunda yardımcı olabilirseniz sevinirim

sayfanın içinede yazdım ne yapmak istediğimi

http://www.dosyaupload.com/4Mzg
 
Aşağıdaki kodları Ana Sayfa sayfasının kod bölümüne yapıştırınız. Sayfayı açtığınızda istediğiniz listelemeyi yapacak, dieğr sayfada X sütununa "Aktarıldı" yazacaktır:
Kod:
Private Sub Worksheet_Activate()
Set s1 = Sheets("Hosting Domain Listesi")
Set s2 = Sheets("Ana Sayfa")
son = s1.Cells(Rows.Count, "A").End(3).Row
For i = 1 To son
    If s1.Cells(i, "J") <> "" And s1.Cells(i, "R") <> "" Then
        If IsDate(s1.Cells(i, "J")) = True And IsDate(s1.Cells(i, "R")) = True Then
            If s1.Cells(i, "X") <> "Aktarıldı" Then
                If s1.Cells(i, "J") - Date <= 30 Or s1.Cells(i, "R") - Date <= 30 Then
                    yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
                    s1.Range("A" & i & ":W" & i).Copy: s2.Cells(yeni, "A").PasteSpecial Paste:=xlPasteValues
                    s1.Cells(i, "X") = "Aktarıldı"
                End If
            End If
        End If
    End If
Next
End Sub
 
Alternatif olsun.

Kod:
Sub aktar()
Dim a(), b(), i As Long, Say As Long, y As Byte
Dim s1 As Worksheet, S2 As Worksheet
Set s1 = Sheets("Hosting Domain Listesi")
Set S2 = Sheets("Ana Sayfa")
a = s1.Range("A11:W" & s1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
For i = 1 To UBound(a)
    If a(i, 10) - Date < 30 Or CDbl(a(i, 18)) - Date < 30 Then
        Say = Say + 1
        For y = 1 To UBound(a, 2)
            b(Say, y) = a(i, y)
        Next y
    End If
Next i
S2.Range("A6:W" & Rows.Count).ClearContents
If Say > 0 Then
    S2.[A6].Resize(Say, UBound(a, 2)) = b
End If
MsgBox "İşlem tamam...", vbInformation
End Sub
 
arkadaşlar çok teşekkür ederim aslında tam olarak istediğim bu değildi.
Bunda son 30 günü kalanı ana sayfaya kopyalıyor.
Ben son 30 günü kalanları ana sayfada aynı hosting domain listesi sayfasındaki gibi gözükmesini, ve hosting domain listesi sayfasından h9 daki yada p9 daki yenileme tarihini uzattığımda ana sayfa isimli sayfadan silinsin istiyorum. bunu yapabilirmiyiz.
 
Yenileme tarihini uzattıktan sonra kodu tekrar çalıştırdığınızda silinmesi gerekiyor zaten. Sizin istediğiniz kodu tekrar çalıştırmadan mı olması?
 
istediğim hosting sayfasındaki gün otomatik düşüyor ya 3 gün kaldı 2 gün kaldı diye o ekranın aynısını sadece 30 günü kalan ve süresi bitenleri ana sayfa sayfasında göstermesi aynı biçimde geri sayması süreyi uzattığım taktirdede ana sayfadan silinmesini istiyorum.
toplama formülü gibi numara değişir değişmez sonuç gösteriyor ya o şekilde


Umarım anlatabilmişimdir derdimi teşekkürler.
 
Koşullu Biçimlendirme'lerinizi düzeltmeniz gerekmektedir. Ben sizinkileri bilerek düzeltmedim ama Koşullu Biçimlendirme, Kuralları Yönet bölümüne girip en altta benim örnek olsun diye düzenlediğim iki tane kural var sizde kendi kurallarınızı ona göre düzenleyin. Yapamazsanız onları da yapayım.
 
Yapamadım hocam, ya hepsi gri ya hepsi kırmızı oluyor boşsa boş bırak diyemedim :)

Kusura bakma sana da zahmet veriyorum
 
Hocam çok teşekkür ederim yardımların için tam istediğim gibi oldu
 
Geri
Üst