• DİKKAT

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

Günü Geldiğinde Bilgileri 2.Çalışma Sayfasına Aktarma

Katılım
13 Ağustos 2010
Mesajlar
14
Excel Vers. ve Dili
Türkçe
Sayın Necdet Yeşertener,

Öncelikle İhale takip makrosunu hazırladığın için tekrardan teşekkür ederim. Kendi çabalarımla hazırlamış olduğunuz makroyu değiştirip geçici teminat takip listesine uygulamak istedim çoğu yerinde başarılı olduğumu düşünüyorum ama bir sorun var H sutunundaki tarihlerin hepsi A2 sutununda görülen tarihten küçük dolayısıyla tüm hücrelerin 2.sayfaya aktarılması gerekiyor ama burada bi sorun var. İlgilenirseniz çok memnun kalacağım. Örneği ekte sunuyorum.
 

Ekli dosyalar

Merhaba,

Kodlarda Kırmızı olan yerleri değiştirdim, ayrıca H sütununda boş hücreye karşılaştığında döngü duruyor, dosyanızda da arada boş satırlar var dikkat etmek gerek.

i değişkeninin değerini satırı sildiği için arttırmadım, çünkü diyelimki 5. satır koşula uyuyor sildik, 6. satır 5. satırın yerine gelir, o arada değişkeni de 1 arttırırsanız 5. satıra yerleşen değer şarta uygun olsa bile değişkenin değeri 6 olduğu için arada kalır.

Kod:
Private Sub Workbook_Open()
    
    Dim wsK As Worksheet, _
        wsN As Worksheet, _
        i   As Long, _
        j   As Long, _
        Adt As Integer
    
    Set wsK = Sheets("Geçici")
    Set wsN = Sheets("İade")
    
    Application.ScreenUpdating = False
    
    wsK.Select
    j = wsN.Cells(Rows.Count, "A").End(3).Row
    i = 3
    
    Do Until Cells(i, "H") = ""
        If [COLOR=red]Not Cells(i, "H") > Range("A2")[/COLOR] Then
            j = j + 1
            Adt = Adt + 1
            Range("A" & i & ":H" & i).Copy wsN.Cells(j, "A")
            Range("A" & i & ":H" & i).Delete Shift:=xlUp
       [COLOR=red] Else
            i = i + 1
[/COLOR]        End If
    Loop
    
    If Adt = 0 Then
        MsgBox "İade Edilen Teminat Mektubu Bulunamadı...", vbInformation, "Teşekkürler Sayın N. YEŞERTENER / [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL] / Osman SÜNGÜ"
    Else
        MsgBox "En Son " & Adt & " Adet Mektup İade Edilmiş ve İadelere Aktarılmıştır...", vbInformation, "Teşekkürler Sayın N. YEŞERTENER / [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL] / Osman SÜNGÜ"
    End If
    
    Application.ScreenUpdating = True
    
End Sub
 
Merhaba,

Kodlarda Kırmızı olan yerleri değiştirdim, ayrıca H sütununda boş hücreye karşılaştığında döngü duruyor, dosyanızda da arada boş satırlar var dikkat etmek gerek.

i değişkeninin değerini satırı sildiği için arttırmadım, çünkü diyelimki 5. satır koşula uyuyor sildik, 6. satır 5. satırın yerine gelir, o arada değişkeni de 1 arttırırsanız 5. satıra yerleşen değer şarta uygun olsa bile değişkenin değeri 6 olduğu için arada kalır.

Kod:
Private Sub Workbook_Open()
    
    Dim wsK As Worksheet, _
        wsN As Worksheet, _
        i   As Long, _
        j   As Long, _
        Adt As Integer
    
    Set wsK = Sheets("Geçici")
    Set wsN = Sheets("İade")
    
    Application.ScreenUpdating = False
    
    wsK.Select
    j = wsN.Cells(Rows.Count, "A").End(3).Row
    i = 3
    
    Do Until Cells(i, "H") = ""
        If [COLOR=red]Not Cells(i, "H") > Range("A2")[/COLOR] Then
            j = j + 1
            Adt = Adt + 1
            Range("A" & i & ":H" & i).Copy wsN.Cells(j, "A")
            Range("A" & i & ":H" & i).Delete Shift:=xlUp
       [COLOR=red] Else
            i = i + 1
[/COLOR]        End If
    Loop
    
    If Adt = 0 Then
        MsgBox "İade Edilen Teminat Mektubu Bulunamadı...", vbInformation, "Teşekkürler Sayın N. YEŞERTENER / [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL] / Osman SÜNGÜ"
    Else
        MsgBox "En Son " & Adt & " Adet Mektup İade Edilmiş ve İadelere Aktarılmıştır...", vbInformation, "Teşekkürler Sayın N. YEŞERTENER / [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL] / Osman SÜNGÜ"
    End If
    
    Application.ScreenUpdating = True
    
End Sub

Usta çok teşekkür ederim.Bu macro konusunda hiç bilgim yok bu yüzden deneme yanılma ile değiştirdim bir çok yerini ama başaramadım yinede sonuca yaklaşmışım :) bu arada boş kalan satırda işlemin sonlandırıldığını bilmiyordum bunuda öğrenmiş oldum. Yardımların tekrardan teşekkür ederim. Bi an önce şu macro olayını çözmem gerek :))
 
bu arada boş kalan satırda işlemin sonlandırıldığını bilmiyordum bunuda öğrenmiş oldum.

Böyle bir şart yok tabi ama sizin kodlarınız buna göre düzenlenmiş, o yüzden açıkladım.

Kodlar, arada boş hücre olsa da olmasada son veriye kadar gider şeklinde de düzenlenebilir.
 
Böyle bir şart yok tabi ama sizin kodlarınız buna göre düzenlenmiş, o yüzden açıkladım.

Kodlar, arada boş hücre olsa da olmasada son veriye kadar gider şeklinde de düzenlenebilir.


usta bu macroyu ben yazmadım ki :) senin bana ihale takibi için hazırladığın macronun bir iki yerini değiştirerek birşeyler yapmaya çalıştım. Yani içeriğini çok fazla bilmiyorum :) boş satırlarda durmaması için hangi bölgeyi değiştirmem gerekiyor sana zahmet bunuda söylermisin ?
 
Geri
Üst