Verilen Değere Göre Tablo Oluşturma

[Cumas]

İyi Akşamlar herkese
KAR adında HİSSE işlemlerinin kaydedildiği bir tablomuz var. Bu tablomuza hergün bir veya birden fazla yeni kayıtlar yapılmaktadır.
İstediğim şu. Başka bir sayfada; seçtiğimiz bir hissenin KAR tablosunda yer alan tüm işlemlerini listeleyecek.
Bu işlemi filtre uygulayarak çok kolay yapılabilir. Bunu yapmasını biliyorum. Ancak ben başka bir sayfada bu şekilde bir rapor oluşturulmasını istiyorum. Maksadım rapor sayfası ayrı olacak. Birde KAR tablosuna kayıtları sadece bir kişi yapıyor ve diğerlerisadece rapor sayfasıyla ilgili olacak. KAR sayfası üzerinde herhangi bir yetkileri olmayacak.
Örnek dosyamız ektedir. Dosyada soru ve açıklamalar mevcuttur.
ilgilenen herkese ve çözüm üretenlere şimdiden teşekkür ederim.
Kolay gelsin.

 

[yanginci34]

Merhaba denermisiniz.
http://dosya.co/qou2tqlpjp37/Koşula_Göre_Tablo-1_aktar.xlsm.html

 

[Ömer BARAN]

Merhaba. Alternatif olsun.

► Formül ile çözüm:
-- İŞLEMLER sayfası P5 hücresine aşağıdaki formülü uygulayın ve bu hücreyi aşağı doğru listenin son dolu satırına kadar kopyalayın.
(Burada koşula uyan satırlara 1'den başlayarak sıra numarası verilmiş oluyor)
.

=[COLOR="red"]EĞER[/COLOR](B5=Sayfa1!$C$4;[COLOR="red"]MAK[/COLOR](İŞLEMLER!$P$4:P4)+1;"")

-- Sayfa1 B9 hücresine aşağıdaki formülü uygulayıp sağa ve aşağıya doğru kopyalayın (BOŞ SONUÇ elde edinceye kadar),
(Sütunların biçim ayarlarını TARİH vs olarak düzeltin verilen sıra numarasına göre bilgiler çağrılıyor.)
.

=[COLOR="red"]EĞER[/COLOR]([COLOR="red"]SATIR[/COLOR](A1)>[COLOR="red"]MAK[/COLOR](İŞLEMLER!$P:$P);"";[COLOR="red"]KAYDIR[/COLOR](İŞLEMLER!$B$1;[COLOR="red"]KAÇINCI[/COLOR]([COLOR="red"]SATIR[/COLOR](A1);İŞLEMLER!$P:$P;0)-1;[COLOR="Red"]SÜTUN[/COLOR](A1)-1))

► Makro ile çözüm:
-- Alt taraftan Sayfa1 isimli sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağ taraftaki BOŞ alana aşağıdaki kodları yapıştırın.
C4'deki açılır listeden seçim yaptığınızda istenilen sonuç oluşur.
.

[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [C4]) Is Nothing Then Exit Sub
Call HISSE_GETIR
[B]End Sub

Sub HISSE_GETIR()[/B]
If Sheets("sAYFA1").Cells(Rows.Count, 2).End(3).Row > 8 Then _
Sheets("sAYFA1").Range("B9:O" & Cells(Rows.Count, 2).End(3).Row).ClearContents
On Error Resume Next
Sheets("İŞLEMLER").ShowAllData
Sheets("İŞLEMLER").Range("$B$4:$O$" & Rows.Count).AutoFilter Field:=1, Criteria1:=Sheets("sAYFA1").[C4]
If Sheets("İŞLEMLER").Cells(Rows.Count, 2).End(3).Row = 4 Then Exit Sub
Sheets("İŞLEMLER").Range("B5:O" & Sheets("İŞLEMLER").Cells(Rows.Count, 2).End(3).Row).SpecialCells(xlCellTypeVisible).Copy
Sheets("sAYFA1").[b9].PasteSpecial Paste:=xlPasteValues
Sheets("İŞLEMLER").Range("$B$4:$O$" & Rows.Count).AutoFilter Field:=1
Sheets("sAYFA1").[C4].Activate
[B]End Sub[/B]