ÇÖZÜLDÜ: Yazdır sayfası yazılacak alanın makro kodu ne olmalı?

[assenucler]

Değerli dostlar merhabalar ve hayırlı Ramazanlar.


Ekli dosyamda "Sayfa1 Özeti'"ndeki kayıtları, K1 ve L1 aralığındaki tarihe göre süzüp, "Yazdır" sayfasına makro ile kopyalanması için nasıl bir kod oluşturulmalıdır?

Her zaman olduğu gibi, değerli dostların yardımını bekliyorum.

Sevgi ve saygılar.

 

[EmrExcel16]

Merhaba Dosyanıza boş bir modül ekleyip aşağıdaki kodu ekleyiniz

Sub Kopyala()

Dim i As Integer, satir As Integer

satir = [COLOR="Red"]2[/COLOR]
Sheets("Yazdır").Range("A2:I1000").ClearContents

    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row

        If Range("K1").Value <[COLOR="Red"]=[/COLOR] Cells(i, "A") Then
            If Range("L1").Value >[COLOR="Red"]=[/COLOR] Cells(i, "A") Then
    
                Sheets("Yazdır").Cells(satir, "A").Value = Cells(i, "A").Value
                Sheets("Yazdır").Cells(satir, "B").Value = Cells(i, "B").Value
                Sheets("Yazdır").Cells(satir, "C").Value = Cells(i, "C").Value
                Sheets("Yazdır").Cells(satir, "D").Value = Cells(i, "D").Value
                Sheets("Yazdır").Cells(satir, "E").Value = Cells(i, "E").Value
                Sheets("Yazdır").Cells(satir, "F").Value = Cells(i, "F").Value
                Sheets("Yazdır").Cells(satir, "G").Value = Cells(i, "G").Value
                Sheets("Yazdır").Cells(satir, "H").Value = Cells(i, "H").Value
                Sheets("Yazdır").Cells(satir, "I").Value = Cells(i, "I").Value
    
                satir = satir + 1

            End If
         End If
    Next
  MsgBox "Tamam"

End Sub

 

[assenucler]

Teşekkür ve bir sorun

Sayın emr123,

İlginiz için teşekkürler.

Yazdır sayfasının ilk satırında, önceki sayfanın ilk satırındaki sütun başlıkları olması gerekiyor.

Ayrıca, Yazdır sayfasına eklenen resimdeki gibi, renklendirme olabilir mi?

Tarih aralığına 18.05.2017 - 31.05.2017 yazdığımda;
listelemeyi 22.05.2017-30.05.2017 tarih aralığına göre yapıyor.

 

[EmrExcel16]

Vermiş olduğum kodda kırmızı alanları güncelledim bu şekilde deneyebilir misiniz ?

 

[assenucler]

Sorun var

Sayın emr123,


Bendeki ana dosyayı ekliyorum.

Sizin verdiğiniz kodu, Sayın ziynettin ve YUSUF44 üstatların daha önce yardımcı olduğu dosyaya ekledikten sonra:

K1 ve L1 hücresine 18.05.2017 - 31.05.2017 tarihlerini girip, "KOPYALA" düğmesine tıkladığımda, görüleceği gibi Yazdır sayfasına sadece 18.05.2017 ve 22.05.2017 tarihine ilişkin 2 satırlık bir kayıt getiriyor.

Acaba, önceki kodlarla sizin kodunuz birbirini etkiliyor olabilir mi?

Emek ve yardımınız için teşekkürler.

 

[EmrExcel16]

Tamam da benim gördüğümde vermiş olduğunuz tarihler arasında zaten iki kayıt gözüküyor ben neyi kaçırıyorum acaba gözden siz kaç kayıt olması gerektiğini söyleyebilirmisiniz

 

[assenucler]

Sayfa1 Özeti sayfasında 18.05.2017 - 31.05.2017 tarihleri arasındaki kayıtlar

72 ve 79 nolu satırlar arasındaki 8 kayıt olmalıdır.

Üstteki iletime eklediğim dosyanın "Yazdır" sayfasına eklediğim resimde de 8 kayıt olduğu görülecektir.

 

[assenucler]

8 satır kaydının kopyalanması niye 55 saniye sürüyor

Değerli üstatlarım,

Hayırlı pazarlar ve Ramazanlar.

Ekli dosyanın "Sayfa1 Özeti" sayfasındaki verilerin K1 ve L1' deki tarih aralığındaki satır sayısı 8 olmasına karşın, "KOPYALA" düğmesine tıklanınca, YAZDIR sayfasına kopyalama süresi 55 saniye sürüyor.

Nasıl hızlandırılabilir?

Yardımınız için teşekkürler.

 

[Korhan Ayhan]

Deneyiniz.

Sub Kopyala()
    Dim i As Integer, satir As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    satir = 2
    Sheets("Yazdır").Range("A2:I1000").ClearContents
    
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        If Range("K1").Value <= Cells(i, "A") Then
            If Range("L1").Value >= Cells(i, "A") Then
                Sheets("Yazdır").Cells(satir, "A").Value = Cells(i, "A").Value
                Sheets("Yazdır").Cells(satir, "B").Value = Cells(i, "B").Value
                Sheets("Yazdır").Cells(satir, "C").Value = Cells(i, "C").Value
                Sheets("Yazdır").Cells(satir, "D").Value = Cells(i, "D").Value
                Sheets("Yazdır").Cells(satir, "E").Value = Cells(i, "E").Value
                Sheets("Yazdır").Cells(satir, "F").Value = Cells(i, "F").Value
                Sheets("Yazdır").Cells(satir, "G").Value = Cells(i, "G").Value
                Sheets("Yazdır").Cells(satir, "H").Value = Cells(i, "H").Value
                Sheets("Yazdır").Cells(satir, "I").Value = Cells(i, "I").Value
                satir = satir + 1
            End If
        End If
    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Tamam"
End Sub

 

[assenucler]

Allah razı olsun

Değerli üstadım;


Çok teşekkür eder ve hayırlı Ramazanlar dilerim.

Sevgi ve saygılar.

 

[assenucler]

Yazdır sayfasında son satıra kadarki alanın makroyla yazılması

Değerli Üstatlarım;



Yukarıda 8. iletideki dosyanın "Yazdır" sayfasındaki verilerin satır sayısı en fazla 32 olacaktır.

Satır sayısı her zaman değişken olacağından, veriler 8 satır ise o aralığın, 20 satır ise o aralığın yazılması için "Yazdır" butonuna ilişkin kod nasıl olmalıdır?

Yazdır sayfa resmi ilişiktedir.

Ramazanınızı kutlar, yardımınız için önceden teşekkür ederim.

Sevgi ve saygılar.

 

[assenucler]

Sayın Ömer;

Üstadım aşağıdaki linkte bir üyemizin sorusuna verdiğiniz yanıttaki makro kodu, tam benim de istediğim bir cevaptı.

Teşekkürler, hayırlı Ramazan'lar.

Sevgi ve saygılar.


http://www.excel.web.tr/f48/yazdyrma-t163690.html