BELİRLİ KRİTERE GORE FİLTRE ATARAK YENİ DOSYA OLUŞTURMA

[Astalavista58]

Merhaba herkese kolay gelsin, benim internetten indirip günlük veri çektiğim “Günlük” isminde excel dosyam var ve 34 adet sütun bulunuyor. İndirmiş olduğum bu dosya üzerinde belirli kriterlere göre filtreleme yaparak, yeni excel dosyası oluşturuyorum. Makro Kaydetme yöntemi ile bunu yapmaya çalıştım ancak indirilen dosyada sütunların yerleri değiştiğinden hata veriyor. Benim yapmak istediğim, indirmiş olduğum dosyada, “Durumu” kelimesini bulunca “Pasif” kriterine, “Rütbe” kelimesini bulunca “Amir” ve “Memur” kriterine, “Birimi” kelimesini bulunca “Kayseri” kriterine filtre atsın. Kalan veriyi kopyalayıp Yeni Excel dosyası oluşturarak masaüstüne “Rütbeli” ismiyle kaydetmesini istiyorum. Şimdiden çok teşekkür ederim.

 

[kulomer46]

Değerli Arkadaşım

Konu ilgi çekici. Örnek dosyanızı paylasin inşallah yardımcı olalım.

Selamlar...

 

[Astalavista58]

Tüm sütunların yeri değişebiliyor

 

[Astalavista58]

Yardımcı olabilirseniz çok mutlu olurum, Allah razı olsun

 

[kulomer46]

Merhaba

Dosyanız Hazır.

Selamlar...

 

[Astalavista58]

Ömer Bey elinize sağlık çok teşekkür ederim kod çok güzel çalışıyor Allah razı olsun, bir şey daha rica edebilir miyim. Ben bu kodu boş bir Excele ekleyip, hergün "Günlük" isminde indirdiğim Excelde bu işlemi yaptırmak istiyorum. Nasıl bir revize yapmak gerekir

 

[Astalavista58]

Sub Aktar()
'21.10.2021  13:00
  
    son1 = Cells(1, Columns.Count).End(xlToLeft).Column
    
    sonsatir = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    
    For i = 1 To son1
        
        If Left(Trim(Cells(1, i)), 6) = "Durumu" Or UCase(Left(Trim(Cells(1, i)), 6)) = UCase("Durumu") Or LCase(Left(Trim(Cells(1, i)), 6)) = LCase("Durumu") Then
        
            durumu_yeri = i
            
        ElseIf Left(Trim(Cells(1, i)), 5) = "Rütbe" Or UCase(Left(Trim(Cells(1, i)), 5)) = UCase("Rütbe") Or LCase(Left(Trim(Cells(1, i)), 5)) = LCase("Rütbe") Then
        
            rütbe_yeri = i
            
        ElseIf Left(Trim(Cells(1, i)), 6) = "Birimi" Or UCase(Left(Trim(Cells(1, i)), 6)) = UCase("Birimi") Or LCase(Left(Trim(Cells(1, i)), 6)) = LCase("Birimi") Then
        
            birim_yeri = i
        
        End If
    
    Next
    
    Range("D1").Select
    
    Selection.AutoFilter
    
    ActiveSheet.Range("$A$1:$AA$" & son1).AutoFilter Field:=durumu_yeri, Criteria1:="Pasif"
    
    ActiveSheet.Range("$A$1:$AA$" & son1).AutoFilter Field:=rütbe_yeri, Criteria1:="=Amir", _
    Operator:=xlOr, Criteria2:="=Memur"
    
    ActiveSheet.Range("$A$1:$AA$" & son1).AutoFilter Field:=birim_yeri, Criteria1:="Kayseri"
    
    Cells.Select
    Selection.Copy
    Workbooks.Add
    Cells.Select
'    ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Application.CutCopyMode = False
    Cells.EntireColumn.AutoFit
    Cells(2, 3).Select
    metin = "Rütbeli"
    ActiveWorkbook.SaveAs Filename:="D:\omerorhan-silmeyin\Desktop\" & metin & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    
        
End Sub

Ömer Bey meşgul galiba, bu kodu boş bir Excele ekleyip, hergün "Günlük" isminde indirdiğim masaüstünde bulunan Excelde bu işlemi yaptırmak istiyorum. Nasıl bir revize yapılması gerekir

 

[kulomer46]

Değerli Arkadaşım

Sizin istediğiniz açtığınız her excel dosyasında bu koda ulaşmak ve her açılan excel dosyasında istediğiniz
zaman bu kodun çalışmasını sağlamak.

Bunun için bilgisayarınızdaki tüm excel dosyalarında çalışmasını istediğiniz kodları Windows Klasöründe bulunan
XLSTART klasörünün içindeki PERSONAL.xlsb dosyasına kaydetmeniz lazım..

Böylece tüm Excel dosyalarınızda o kodlar otomatik çalışıyor.

Her excel sürümünde PERSONAL.xlsb dosyasını barındıran XLSTART kalsörünün yeri değişkenlik gösterebiliyor.
Kendi bilgisayarımdaki excel için geçerli XLSTART klasörünün yerini aşağıdaki internet bilgisi yardımıyla bulmuştum.

İnternet Bilgisi:
Office365 veya 2019 64 bit için:
C:\Program Dosyaları\Microsoft Office\root\xx\XLSTART
"xx" kullandığınız sürümü temsil ettiği durumlarda (örneğin, Office15, Office14, vb.).

Bu sitede arama yaparak PERSONAL dosyasına nasıl kod ekleme yapılır bilgilerinede ulaşabilirsiniz.

Örneğin Makro Kaydet yöntemi ile makro kaydetme yeri olarak Makronun saklanacağı yer kısmına
Kişisel Makro Çalışma Kitabı seçerseniz kaydedilen makro otomatik sizin PERSONAL dosyanıza kaydedilir.

Böylece kendi PERSONAL dosyanız otomatik bilgisayar tarafından oluşturulmuş olur.

Daha sonrada Geliştirici - Kod Görüntüle menülerinden devam ederek gelen ekrandan sol taraftaki PERSONAL
dosyanıza kendiniz istediğiniz kodları ekleyebilir, kendi kodlarınızı yazıp bilgisayarınızdaki tüm excel dosyalarında kullanabilirsiniz.

Selamlar...

 

[Astalavista58]

Ömer Bey çok teşekkür ederim Allah sizden razı olsun, dediğiniz gibi yapacağım.

ActiveSheet.Range("$A$1:$AA$" & son1).AutoFilter Field:=rütbe_yeri, Criteria1:="=Amir", _
    Operator:=xlOr, Criteria2:="=Memur"

Bu koda 3. bir kriteri nasıl ekleyeceğim, uğraştım ama olmadı

 

[kulomer46]

Merhaba

Bu şekilde deneyiniz

    ActiveSheet.Range("$A$1:$AA$" & son1).AutoFilter Field:=rütbe_yeri, Criteria1:="=Amir", _
    Operator:=xlOr, Criteria2:="=Memur",  Operator:=xlOr, Criteria3:="=Müdür"

Selamlar...

 

[Astalavista58]

Application-defined or object-defined error, şeklinde hata veriyor

 

[kulomer46]

Merhaba

Birde şu şekilde deneyiniz.

 ActiveSheet.Range("$A$1:$AA$" & son1).AutoFilter Field:=rütbe_yeri, Criteria1:=Array( _
        "Amir", "Memur", "Müdür"), Operator:=xlFilterValues

Selamlar...