filtrelenmiş verileri başka sayfaya otomatik nasıl alabilirim

[cihangirali35]

arkadaşlar öncelikle merhaba. kaç gündür forumunuzda bu konuyu araştırıyorum. ama herşeyi denememe rağmen bir türlü çözemedim.dosyayı eklemek isterdim ama nerden ekleme yapacağımı bulamadım. sorum şu. sayfa 1 de bulunan toplam parsonel listesinden pazartesi çalışacakları süzdüğümde elde edilen a ve b sütünündaki bilgilerin imza listesine ototmatik geçmesini istiyorum. bu konuda bana yardımcı olabilirmisiniz. şimdiden teşekkür ederim

 

[dellerlim]

Merhaba.
Arama motoruna "dosya yükle" yazın orada çıkan herhangi bir siteye örnek dosya yüklerseniz sorununuz çözülebilir umarım.

 

[cems]

dosyayı eklemek isterdim ama nerden ekleme yapacağımı bulamadım.

Sisteme altın üyeler ekleyebilir , altın üye olmayanlar www.dosya.tc gibi sitelere zipli olarak yükleyip , görüntülenen linki burada paylaşarak dosyasına erişilmesini sağlayabilir. Cevap ya kod olarak burada verilir ya da aynı yoldan size gönderilir.

 

[cihangirali35]

ilginize teşekkür ederim. örnek çalışmayı aşağıdaki linke ekledim.

http://www.dosya.tc/server9/45lx7a/imza_cizelgesi.rar.html

 

[Asri]

Çok içime sinmemekle beraber daha iyi bir çözüm olana kadar kullanılabilir.

Sayfa1 in kod bölümüne kopyalayınız. Sayfada otomatik hesaplama açık olmalı.

Sayfa 2 de 28 satır sonra birleştirilmiş hücre var. Bu nedenle 28 satır dan fazla sonuç filtrelenir ise kopyalama yapılmaz.

Açılan web sayfasında büyük indir butonu değil en alttaki küçük indir butonunu tıklayın.
http://dosya.co/xwlsxzzyd4f2/imza_çizelgesi.xlsm.html

Private Sub Worksheet_Calculate()
   Call veri_aktar
End Sub

Sub veri_aktar()
    Set shveri = Sheets("Sayfa1")
    Set shliste = Sheets("Sayfa2")
    sonsatir = shveri.Cells(Rows.Count, "C").End(3).Row
    If sonsatir > [COLOR=Red]28[/COLOR] Then Exit Sub
    shveri.Range("C5:D" & sonsatir).SpecialCells(xlCellTypeVisible).Copy shliste.Range("M1")

    shliste.Columns("N:N").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    sonsatir = shliste.Cells(Rows.Count, "M").End(3).Row
    
    shliste.Range("M1:M" & sonsatir).Copy
    shliste.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    shliste.Range("O1:O" & sonsatir).Copy
    shliste.Range("D9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    shliste.Columns("M:Z").Delete
End Sub

 

[cihangirali35]

Çok içime sinmemekle beraber daha iyi bir çözüm olana kadar kullanılabilir.

Sayfa1 in kod bölümüne kopyalayınız. Sayfada otomatik hesaplama açık olmalı.

Sayfa 2 de 28 satır sonra birleştirilmiş hücre var. Bu nedenle 28 satır dan fazla sonuç filtrelenir ise kopyalama yapılmaz.

Private Sub Worksheet_Calculate()
   Call veri_aktar
End Sub

Sub veri_aktar()
    Set shveri = Sheets("Sayfa1")
    Set shliste = Sheets("Sayfa2")
    sonsatir = shveri.Cells(Rows.Count, "C").End(3).Row
    If sonsatir > [COLOR=Red]28[/COLOR] Then Exit Sub
    shveri.Range("C5:D" & sonsatir).SpecialCells(xlCellTypeVisible).Copy shliste.Range("M1")

    shliste.Columns("N:N").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    sonsatir = shliste.Cells(Rows.Count, "M").End(3).Row
    
    shliste.Range("M1:M" & sonsatir).Copy
    shliste.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    shliste.Range("O1:O" & sonsatir).Copy
    shliste.Range("D9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    shliste.Columns("M:Z").Delete
End Sub

Dediklerinizi yaptım. günlerden süzmeyi yaptığımda elde edilen verilerden hiç biri sayfa 2 deki yere gitmedi. ;(

 

[Asri]

Dediklerinizi yaptım. günlerden süzmeyi yaptığımda elde edilen verilerden hiç biri sayfa 2 deki yere gitmedi. ;(

Dosya eklendi.