• DİKKAT

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

Diğer sayfadan koşullu satır çekme

Y

yildirimi

Katılım
31 Ekim 2009
Mesajlar
39
Excel Vers. ve Dili
Office 365
Merhaba arkadaşlar,

B sütunundan AA sütununa kadar olan günlük raporum var. E sütununda yazan servis isimlerine göre filtreleme yapıp kendi sayfasına listeyi aktarmak istiyorum.

Yani E sütununda kaç adet A Servis yazan varsa hepsi A Servisine ait sayfaya aktarmak istiyorum. Günlük Rapor listesinden silinmeyecek tabi bu bilgiler.

Bu konuda yardımcı olabilirseniz çok sevinirim.

Örnek dosya linki: http://s3.dosya.tc/server18/HCQ1cz/a.xlsx.html

 
Son düzenleme:
. . .

Örnek dosya eklerseniz, daha hızlı ve net cevaplar alabilirsiniz.

. . .
 
. . .

Kodları boş bir modüle yapıştırınız.

Kod: 
Sub Kod()
    Application.ScreenUpdating = False
    Dim Sayfa  As String
    Dim say    As Long
    Dim S1     As Worksheet
    Set S1 = Sheets("Sayfa1") [COLOR="Green"]' sürekli Sayfa1 yazmamak için kısa değişken tanımlıyoruz[/COLOR]
    say = 0

    For a = 2 To S1.[E65536].End(3).Row [COLOR="Green"]' Sayfa1 de E sütununda son dolu hücreye kadar çalış[/COLOR]
        If S1.Cells(a, "AB") = "Aktarıldı" Then [COLOR="Green"]' AB sütnunda Aktarıldı yazıyorsa tekrar aktarma[/COLOR]
        Else
            Sayfa = S1.Cells(a, "E") [COLOR="Green"]' E sütunundaki sayfa ismi var mı?[/COLOR]
            If Not SayfaVarMi(Sayfa) Then
                MsgBox Sayfa & " Yok", vbCritical [COLOR="Green"]' yoksa uyarı ver[/COLOR]
            Else [COLOR="Green"]' varsa işleme devam et[/COLOR]
                S1.Range("A" & a & ":AA" & a).Copy _
                        Sheets(Sayfa).Range("A" & Sheets(Sayfa).[E65536].End(3).Row + 1)
[COLOR="Green"]' Sayfa1 A:AA aralığını kopyala, 
'ilgili sayfaya A sütununda son dolu hücrenin altına yapıştır.[/COLOR]
                
Sheets(Sayfa).Cells(Sheets(Sayfa).[E65536].End(3).Row, "A") = _
                        Sheets(Sayfa).[E65536].End(3).Row - 1
[COLOR="Green"]' İlgili sayfada A sütununa sıra no gir[/COLOR]

                S1.Cells(a, "AB") = "Aktarıldı" [COLOR="Green"]' Sayfa1 AB sütununa aktarıldı yaz[/COLOR]
                say = say + 1[COLOR="Green"] ' toplam aktarılan kayıt sayısını hesapla[/COLOR]
            End If
        End If
    Next a
    Application.ScreenUpdating = True
    MsgBox " B i t t i " & Chr(10) & say & " adet kayıt aktarıldı. "
End Sub


Function SayfaVarMi(Sayfa As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function

. . .
 
Son düzenleme:
Teşekkür ederim. Aktarma işlemini sağlıklı bir şekilde yapıyor.

Yalnız kodları açıklamanız mümkün mü?

Servis C - Servis D'yi eklemek için ne yapmam gerekir? Bir de Servislerin sayfalarında sütunlar A'dan değil AA'dan başladığı için onu nasıl düzenleyebilirim. Yardımcı olursanız çok sevinirim.
 
. . .

Kodların açıklamaları 4 nolu mesaja eklendi.
E sütununda yazan Sayfa isimlerden, tabloda açılmış sayfa olması gerekiyor.
Kodlara herhangi bir ekleme yapmanıza gerek yok. Sayfa yoksa uyarı verecektir.

. . .
 
Açıklamalar için teşekkür ederim öğrenebilmek adına çok yararlı oldu.

Birde servis sayfalarında tablo AA 9 dan başlıyor. Kopyalama işlemini AA sütunun 9'uncu satırından nasıl başlatabilirim?
 
. . .

Keşke örnek dosyanızı bu şekilde hazırlasaydınız.
Mavi ile belirttiğim kısımları değiştirin.
Yapamazsanız son hali ile örnek ekleyin. Üzerinde yapalım.

Kod: 
            Else
[COLOR="Blue"]                S1.Range("A" & a & ":AA" & a).Copy _
                        Sheets(Sayfa).Range("AA" & Sheets(Sayfa).[AE65536].End(3).Row + 1)

                Sheets(Sayfa).Cells(Sheets(Sayfa).[AE65536].End(3).Row, "AA") = _
                        Sheets(Sayfa).[AE65536].End(3).Row - 1[/COLOR]

                S1.Cells(a, "AB") = "Aktarıldı"


. . .
 
Merhaba Hüseyin Bey,

Evet haklısınız o konuda hata yaptım. Söylediğiniz gibi düzenlediğimde sağlıklı bir şekilde çalışıyor. Yardımlarınız için çok teşekkür ederim.
 
Tekrar merhaba,

Şöyle bir hata olduğunu fark ettim.

Verileri çekerken tarihte hata yapıyor. Çektiğim ilk tarih mesela 30 Ocak ise altına gelen tarihler 31 - 32 - 33 - 34 diye devam ediyor. B sütununu kopyalarken gün rakamını almıyor sanırım.
 
. . .

Hata aldığınız dosyanın örneğini ekleyiniz.

. . .
 
. . .

Sıkıntı nedir anlamadım ?

Şöyle yapalım.
Hatalı yaptığı işlem şu, doğrusu bu şekilde olmalı diye 2 resim ekleyebilirsiniz.

. . .
 
A sütununda sıra nolar mevcut. Oradan anlatırsam daha net olacak sanırım.

Sıra numarası 14 olan satıra bakacak olursak listede 7 ocak olarak gözüküyor. Ama makroyu çalıştırıp satırları sayfalara kopyaladığımızda 10 Ocak olarak gözüküyor. Sayfalardaki tarih rakamları 1'den başlayarak sıralı şekilde devam ediyor.
 
. . .

Satırları sayfalara aktardıktan sonra AA sütununa göre tekrar sıra numarası veriyor.
Çünkü örnek dosyada bu şekildeydi.
Kodların açıklamasında tekrar sıra no veren kod satırını belirttim. Bu satırı silerek deneyiniz.
Kod: 
Sheets(Sayfa).Cells(Sheets(Sayfa).[AE65536].End(3).Row, "AA") = _
                        Sheets(Sayfa).[AE65536].End(3).Row - 1

. . .
 
Teşekkür ederim Hüseyin bey. Şuanda doğru aktarımı sağlayabildim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst