şarta bağlı veri kopyalama

[kahramang1]

Merhabalar. Sizlerden ricam "tavdi bordrosu" sayfasınsaki "teslim tarihi" hücresine tarih yazdığımda "lisate" sayfasına gidip L sütunundaki tairihlerle eşleşen "borçlu", "vade", "tutar" değerlerini kopyalayıp, "tevdi bordrosu" sayfasına A4 hücresinden itibaren değerleri aşağı kaydırıp, tarihle eşleşen değerleri kopyalamasıdır. Teşekkürler.

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub senetler()
    Set s1 = Sheets("tevdi bordrosu")
    Set s2 = Sheets("LİSTE")
    Set s3 = Sheets("şablon")
    sonL = s2.Cells(Rows.Count, "L").End(3).Row
    eski = WorksheetFunction.Max(s3.Cells(Rows.Count, "E").End(3).Row, 2)
    sat = WorksheetFunction.Match("Şehir içi", s1.[A:A], 0)
    If sat > 5 Then
        s1.Rows("4:" & sat - 1).Delete Shift:=xlUp
    End If
    If s1.[AP3] = "" Then
        MsgBox "Lütfen listelenecek tarihi giriniz!", vbCritical
        Exit Sub
    ElseIf WorksheetFunction.CountIf(s2.Range("L1:L" & sonL), s1.[AP3]) = 0 Then
        MsgBox "LİSTE sayfasında belirtilen tarihli kayıt bulunamadı!", vbCritical
        Exit Sub
    Else
        s3.Range("A2:AI" & eski).ClearContents
        For i = 2 To sonL
            If s2.Cells(i, "L") = s1.[AP3] Then
                yeni = s3.Cells(Rows.Count, "E").End(3).Row + 1
                s3.Cells(yeni, "E") = s2.Cells(i, "G")
                s3.Cells(yeni, "I") = s2.Cells(i, "H")
                s3.Cells(yeni, "V") = "KAYSERİ"
                s3.Cells(yeni, "AA") = s2.Cells(i, "C")
                s3.Cells(yeni, "AE") = s2.Cells(i, "D")
            End If
        Next
        s3.Rows("2:" & yeni).Copy: s1.[A4].Insert Shift:=xlDown
        Application.CutCopyMode = False
    End If
End Sub

 

[kahramang1]

bu makro nasıl çalışır, çalışması için bir düğme var mı. Ben "inset" - "modüle" deyip ekledim. Ama nasıl çalışacak anlamadım (

 

[YUSUF44]

Makro ekleme ve çalıştırma aşamaları:

Önce kodları kopyalayın
Excel dosyasında iken Alt+F11 yapın ya da sayfa sekmesi üzerine sağ tıklayıp Kod görüntüle diyerek kod sayfasını açın.
Açılan sayfada Insert menüsünden Module'yi seçin
boş sayfa açılacak, o sayfaya kodları yapıştırın
Excel sayfasına geçin
Sayfaya bir düğme/şekil/nesne ekleyin
Eklediğinize sağ tıklayıp makro ata deyin
Açılan listede nobet isimli makroyu seçip işlemi tamamlayın
Artık o düğmeye/şekle/nesneye tıkladığınızda makro çalışacak ve istediğiniz sonuçları listeleyecektir.

 

[kahramang1]

Sub senetler()
Set s1 = Sheets("tevdi bordrosu")
Set s2 = Sheets("L?STE")
Set s3 = Sheets("?ablon") - (bu satır sarı boyalı) - debug diye bir hata verdi.
sonL = s2.Cells(Rows.Count, "L").End(3).Row
eski = WorksheetFunction.Max(s3.Cells(Rows.Count, "E").End(3).Row, 2)
sat = WorksheetFunction.Match("?ehir i?i", s1.[A:A], 0)
If sat > 5 Then
s1.Rows("4:" & sat - 1).Delete Shift:=xlUp
End If
If s1.[AP3] = "" Then
MsgBox "L?tfen listelenecek tarihi giriniz!", vbCritical
Exit Sub
ElseIf WorksheetFunction.CountIf(s2.Range("L1:L" & sonL), s1.[AP3]) = 0 Then
MsgBox "L?STE sayfas?nda belirtilen tarihli kay?t bulunamad?!", vbCritical
Exit Sub
Else
s3.Range("A2:AI" & eski).ClearContents
For i = 2 To sonL
If s2.Cells(i, "L") = s1.[AP3] Then
yeni = s3.Cells(Rows.Count, "E").End(3).Row + 1
s3.Cells(yeni, "E") = s2.Cells(i, "G")
s3.Cells(yeni, "I") = s2.Cells(i, "H")
s3.Cells(yeni, "V") = "KAYSER?"
s3.Cells(yeni, "AA") = s2.Cells(i, "C")
s3.Cells(yeni, "AE") = s2.Cells(i, "D")
End If
Next
s3.Rows("2:" & yeni).Copy: s1.[A4].Insert Shift:=xlDown
Application.CutCopyMode = False
End If
End Sub

 

[kahramang1]

Ayrrıca "nöbet" diye bir makro yok. "senetler" diye makro var. O da bu hatayı verdi.

 

[kahramang1]

Hata ile alakalı resim ektedir.

 

[YUSUF44]

Pardon, ben dosyanıza bir şablon eklemiştim. Şimdi o dosyayı paylaşayım. Nöbet konusu da başka bir konudan kopyala yağıştır yaptığımdan, kusura bakmayın.

 

[kahramang1]

estağdirullah. ne kusuru. Ellerinize sağlık. Hemen inceliyorum

 

[kahramang1]

Çok teşekkür ederim. Ellerinize sağlık. Tam istediğim gibi. Kolay gelsin.

 

[kahramang1]

Sayın Yusuf44 merhabalar. En son yaptığınız dosya düzeltmenizde son bir ricam olacaktı sizden. Senetleri girip, tevdi bordrosunda da düzenleme tarihini listele düğmesine bastığım zaman senetleri listeliyor. Lakin ben tevdi bordrosu sayfasının B57 hücresine senet adedini yazsın diye ETOPLA formülü kurmuştum. Her listelemeden sonra bu formül bozuluyor. Yani ETOPLA işlevi her zaman AE4 hücresinden başlaması gerekiyor. Bu işlem için ya da senet adedini yazdırmak için neler yapılabileceğini, ya da makroda gerekli düzeltmeyi yapıp bana gönderirseniz çok sevinirim. Kolay gelsin.

 

[YUSUF44]

Özel mesajla da cevapladığım üzere Etopla formülünü aşağıdakiyle değiştirip deneyin:

=EĞERSAY(şablon!AE2:AE501;">0")

 

[kahramang1]

Çok teşekkür ederim. Problem şimdi düzeldi. Ellerinize sağlık. Kolay gelsin.