• DİKKAT

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

Tarihe göre başka sayfaya data cekmek

Katılım
15 Mart 2014
Mesajlar
20
Excel Vers. ve Dili
2010
türkçe
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

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
 
Bu işlem formülle yapılabilir. Bilginiz olsun.
 
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
 
Geri
Üst