DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
=EĞERHATA(İNDİS(Sayfa1!$A$1:$G$10000;KÜÇÜK(EĞER(Sayfa1!$A$1:$A$10000=$B$1;SATIR(Sayfa1!$A$1:$A$10000));SATIRSAY(A$3:A3));SÜTUN(B$1));"")
[FONT="Arial Narrow"][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Call listele
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
Target.Select
[B]End Sub[/B]
[B]Sub listele()[/B]
Set S1 = Sheets("Sayfa1"): Set S3 = Sheets("Sayfa3")
S1.Range("A1:G1").AutoFilter Field:=1, Criteria1:=S3.[B1].Value
If S3.[A65536].End(3).Row > 2 Then S3.Range("A3:F" & S3.[A65536].End(3).Row).ClearContents
S1.Range("B1:G" & S1.Cells(65536, 1).End(3).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S3.[A2:F2]
S3.Columns("A:F").AutoFit
[B]End Sub[/B][/FONT]
İyi günler dilerim.Çok çok teşekkür ederim arkadaşlar, sonuç tam istediğim gibi olmuş, ellerinize sağlık.