Tarihe göre başka sayfaya data cekmek

Katılım
15 Mart 2014
Mesajlar
20
Excel Vers. ve Dili
2010
türkçe
Altın Üyelik Bitiş Tarihi
11-09-2022
Merhabalar
şimdiden teşekkürler

ekli örnekte.
1.
sayfa da tarih/il/TL data listem var.
Diger sayfamda
Üst de belirteceğim tarihlerdeki birinci sayfadaki verileri. Sheet.yani yeni
Sayfama aktarmak istiyorum...

teşekkürler ilgileriniz için..
 

Ekli dosyalar

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,214
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Doğru anladıysam eğer, aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Kod:
Sub Aktar()

    Dim Sayfa2  As Worksheet, _
        Sheet2  As Worksheet, _
        i       As Long, _
        j       As Integer, _
        BasTar  As Date, _
        BitTar  As Date, _
        Adet    As Integer
    
    Application.ScreenUpdating = False
    
    Set Sayfa2 = Sheets("Sayfa2")
    Set Sheet2 = Sheets("Sheet2")
    
    BasTar = Sheet2.Range("B1")
    BitTar = Sheet2.Range("C1")
    j = 4
    
    For i = 2 To Sayfa2.Cells(Rows.Count, "A").End(3).Row
        If Sayfa2.Cells(i, "A") >= BasTar And Sayfa2.Cells(i, "A") <= BitTar Then
            j = j + 1
            Adet = Adet + 1
            Sayfa2.Range("A" & i & ":C" & i).Copy
            Sheet2.Range("A" & j).PasteSpecial xlPasteValues
        End If
            
    Next i
    
    Application.ScreenUpdating = True
    MsgBox Adet & " Veri Aktarılmıştır......"
    
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,509
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu işlem formülle yapılabilir. Bilginiz olsun.
 
Katılım
15 Mart 2014
Mesajlar
20
Excel Vers. ve Dili
2010
türkçe
Altın Üyelik Bitiş Tarihi
11-09-2022
merhaba,

Doğruysam, oyunun bir modülünü kopyalayıp deneyin.

[KOD]Alt Aktar()

Dim Sayfa2 Çalışma Sayfası Olarak, _
Sayfa2 Çalışma Sayfası Olarak, _
Ben Uzun, _
j Tamsayı olarak, _
Baştar Tarih Olarak, _
BitTar Olarak Tarih, _
Adet Olarak Tamsayı

Application.ScreenUpdating = Yanlış

Sayfa2 = Sayfaları Ayarla("Sayfa2")
Sayfa2'yi Ayarla = Sayfalar("Sayfa2")

BasTar = Sheet2.Range("B1")
BitTar = Sheet2.Range("C1")
j = 4

i = 2 için Sayfa2.Hücreler(Satırlar.Sayı, "A").Son(3).Satır
Eğer Sayfa2.Hücreler(i, "A") >= BasTar Ve Sayfa2.Hücreler(i, "A") <= BitTar Sonra
j = j + 1
Adet = Adet + 1
Sayfa2.Aralık("A" & i & ":C" & i).Kopyala
Sheet2.Range("A" & j).PasteSpecial xlPasteValues
Bitir

sonraki ben

Application.ScreenUpdating = Doğru
MsgBox Adet & " Veri Aktarılmıştır........."

Aboneliği Bitir[/CODE]
[/ALINTI]


Tesekkurler.

Deneyim
 
Katılım
20 Ocak 2005
Mesajlar
526
Excel Vers. ve Dili
Excel 2007 Türkçe
Altın Üyelik Bitiş Tarihi
01-01-2024
Üst