Tarih ve kritere göre başka sayfalardan veri al

[hayri tekin]

Merhaba arkadaşlar,
ekli tabloda yapmak istediğimi kısaca izah ettim,şöyle ki:
Rapor sayfasında değişken kriterim var.Bu kritere ve iki tarih aralığına uyan verileri başka sayfalardan rapor sayfasına yazdırmak istiyorum.Makro ile de olabilir.Sıkıntı olursa bu konuda farklı önerilerinize de açığım.
Şimdiden teşekkür ediyorum.

 

[Orion1]

Dosyanız ekte.Güle Güle kullanın.

Sub aktar()
Dim ilk As Date, son As Date, sat As Long, deg As String, sh As Worksheet
Dim k As Range, adr As String
Sheets("RAPOR").Select
If Range("E1").Value <> "" Then
    deg = Range("E1").Value
    Else
    deg = "*"
End If
If Not IsDate(Range("F1").Value) Then
    MsgBox "lütfen İlk tarihi doğru bir tarih şeklinde giriniz.", vbCritical, "UYARI"
    Range("A1").Select
    Exit Sub
End If
If Not IsDate(Range("G1").Value) Then
    MsgBox "Lütfen Son tarihi geçerli bir tarih giriniz.", vbCritical, "UYARI"
    Range("G1").Select
    Exit Sub
End If
Application.ScreenUpdating = False
Range("A2:E65536").ClearContents
ilk = Range("F1").Value
son = Range("G1").Value
sat = 2
For Each sh In Worksheets
    If sh.Name <> "RAPOR" And sh.Name <> "BANKA KASA" Then
        Set k = sh.Range("F2:F" & sh.Cells(65536, "A").End(xlUp).Row).Find(deg, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                If k.Offset(0, -5).Value >= ilk And k.Offset(0, -5) <= son Then
                    Cells(sat, "A").Value = k.Offset(0, -5).Value
                    Cells(sat, "B").Value = k.Offset(0, -4).Value
                    Cells(sat, "C").Value = k.Offset(0, -3).Value
                    Cells(sat, "D").Value = k.Value
                    sat = sat + 1
                End If
                Set k = sh.Range("F2:F" & sh.Cells(65536, "A").End(xlUp).Row).FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
        Set k = Nothing
    End If
Next sh
Set sh = Nothing
Application.ScreenUpdating = True
MsgBox "Akatarım tamamlandı.", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[hayri tekin]

Sn.Evren Gizlen,
Emeğiniz için çok teşekkür ederim.Ancak "banka kasa" sayfasından veri alamıyorum.Bir ilgilenirseniz çok memnun olacağım.

 

[Orion1]

Sn.Evren Gizlen,
Emeğiniz için çok teşekkür ederim.Ancak "banka kasa" sayfasından veri alamıyorum.Bir ilgilenirseniz çok memnun olacağım.

Evet doğrusdur.Çünkü banka kasa sayfasının formatı başka biçimde sütun yerleri farklı ve 2 tablo var.Sırf bu yüzden diğer sayfalar için yazdığım kodları yeni baştan bir daha sırf o sayfa için yazmam lazım.Buda bana eziyettit.Lütfen banada biraz acıyın.O sayfanında formatını ayni diğer sayfalar gibi yaparsanız arama kriterlerinin içine o sayfayıda hemencecik alıveririm.

 

[hayri tekin]

Sn.Evren Gizlen,
Sizi üzmeyi hiç istemem.Sadece aksaklığı bildirmek istedim.Canınız sağolsun. Sizi seviyoruz, iyiki varsınız..Ben gereğini yaparım.
Sonsuz teşekkürler
İyi çalışmalar

 

[Orion1]

Sn.Evren Gizlen,
Sizi üzmeyi hiç istemem.Sadece aksaklığı bildirmek istedim.Canınız sağolsun. Sizi seviyoruz, iyiki varsınız..Ben gereğini yaparım.
Sonsuz teşekkürler
İyi çalışmalar

Rica ederim.
İyi çalışmalar.