otomatik veri süz

[sratacc]

Selamlar saygılar.
K sütununda ''AAA'' ''BBB'' ''CCC'' gibi veriler bulunmakta, bu verilerden, sadece ''aaa'' metni bulunan satırları göstermesini istiyorum.
Yani kısaca exceldeki filtre komutunu makro ile yapmak istiyorum.

Ayrıca çalışma kitabında iki ayrı sekme bulunuyor, birisi xxx birisi yyy, excel açıldığında hem xxx hemde yyy sekmelerindeki veriler süzülsün istiyorum.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyin.

Private Sub Workbook_Open()
    With Sheets("XXX")
        .Range("A:K").AutoFilter 11, "AAA"
    End With
    
    With Sheets("YYY")
        .Range("A:K").AutoFilter 11, "AAA"
    End With
End Sub

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub auto_open()
Sheets("xxx").Range("K1").AutoFilter field:=1, Criteria1:="aaa"
Sheets("yyy").Range("K1").AutoFilter field:=1, Criteria1:="aaa"

End Sub

 

[sratacc]

Tesekkurler sorunsuz calisti

 

[sratacc]

Ekli dosyayı inceleyiniz.

Sub auto_open()
Sheets("xxx").Range("K1").AutoFilter field:=1, Criteria1:="aaa"
Sheets("yyy").Range("K1").AutoFilter field:=1, Criteria1:="aaa"

End Sub

Sayın Korhan Ayhan ve sayın Orion1 in kodlarının ikisi de çalıştı.
Yalnız şöyle bir sıkıntı var. Aşağıdaki gönderdiğim kodda kullanılacak excel dosyasını ağdan kopyalayıp kendi bilgisayarıma yapıştırıyor, daha sonra bu bilgisayara kopyalanan dosyayı açıyorum.Bu açılan dosyaya autoopen ile değil de kodu eklediğim excel dosyasından nasıl filtre yaptırabilirim.

Private Sub HNIHATDOSYASINIAC_Click()
' AĞDAN DOSYAYI KOPYALAYIP D YE YAPIŞTIRACAK, SONRA KOPYALANAN DOSYA AÇILACAK
On Error Resume Next
KAYNAK = "\\HNIHATOZTURK\dosya\DOSYA.xlsm"
HEDEF = "D:\CTD\SABLONN GENEL YAZILAR\HNIHAT_EVRAKKAYITDOSYASI\"
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
DosyaSistemi.CopyFile KAYNAK, HEDEF

DOSYA = "D:\CTD\SABLONN GENEL YAZILAR\HNIHAT_EVRAKKAYITDOSYASI\DOSYA.xlsm"
If DOSYA <> "" Then
CreateObject("Shell.Application").Open (DOSYA)
End If

Worksheets("DOSYA.xlsm").Sheets("GELEN-GİDEN").Range("K1").AutoFilter field:=11, Criteria1:="CCC"
Worksheets("DOSYA.xlsm").Sheets("KURUM GÖRÜŞLERİ").Range("k1").AutoFilter field:=11, Criteria1:="CCCI"

End Sub

 

[Orion1]

İlk filtrede "CCC" süzüldüğü halde 2nci filtrede "CCCI" süzülüyor,dikkat.
Aşağıdaki kırmızı satırları ekledim.

Private Sub HNIHATDOSYASINIAC_Click()
' AĞDAN DOSYAYI KOPYALAYIP D YE YAPIŞTIRACAK, SONRA KOPYALANAN DOSYA AÇILACAK
On Error Resume Next
KAYNAK = "\\HNIHATOZTURK\dosya\DOSYA.xlsm"
HEDEF = "D:\CTD\SABLONN GENEL YAZILAR\HNIHAT_EVRAKKAYITDOSYASI\"
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
DosyaSistemi.CopyFile KAYNAK, HEDEF

DOSYA = "D:\CTD\SABLONN GENEL YAZILAR\HNIHAT_EVRAKKAYITDOSYASI\DOSYA.xlsm"
If DOSYA <> "" Then
    CreateObject("Shell.Application").Open (DOSYA)
[B][COLOR="Red"]    ActiveWorkbook.Sheets("GELEN-GİDEN").Range("K1").AutoFilter field:=11, Criteria1:="CCC"
    ActiveWorkbook.Sheets("KURUM GÖRÜŞLERİ").Range("k1").AutoFilter field:=11, Criteria1:="CCCI"[/COLOR][/B]
End If
End Sub

 

[sratacc]

İlk filtrede "CCC" süzüldüğü halde 2nci filtrede "CCCI" süzülüyor,dikkat.
Aşağıdaki kırmızı satırları ekledim.

Private Sub HNIHATDOSYASINIAC_Click()
' AĞDAN DOSYAYI KOPYALAYIP D YE YAPIŞTIRACAK, SONRA KOPYALANAN DOSYA AÇILACAK
On Error Resume Next
KAYNAK = "\\HNIHATOZTURK\dosya\DOSYA.xlsm"
HEDEF = "D:\CTD\SABLONN GENEL YAZILAR\HNIHAT_EVRAKKAYITDOSYASI\"
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
DosyaSistemi.CopyFile KAYNAK, HEDEF

DOSYA = "D:\CTD\SABLONN GENEL YAZILAR\HNIHAT_EVRAKKAYITDOSYASI\DOSYA.xlsm"
If DOSYA <> "" Then
    CreateObject("Shell.Application").Open (DOSYA)
[B][COLOR="Red"]    ActiveWorkbook.Sheets("GELEN-GİDEN").Range("K1").AutoFilter field:=11, Criteria1:="CCC"
    ActiveWorkbook.Sheets("KURUM GÖRÜŞLERİ").Range("k1").AutoFilter field:=11, Criteria1:="CCCI"[/COLOR][/B]
End If
End Sub

Hocam daha once sizin verdiginiz haliyle denemistim fakat kod bu haliyle suzme yapmiyor.

 

[Orion1]

CreateObject("Shell.Application").Open (DOSYA)

Yukarıdaki kodun yerine aşağıdaki kodu yazarak deneyiniz.

Workbooks.Open (DOSYA)

 

[sratacc]

CreateObject("Shell.Application").Open (DOSYA)

Yukarıdaki kodun yerine aşağıdaki kodu yazarak deneyiniz.

Workbooks.Open (DOSYA)

hocam tamamdir, sagolun

 

[Orion1]

hocam tamamdir, sagolun

Rica ederim.
iyi çalışmalar.