Filtre seçiminde kriter olarak eşit olmayanları getirmek

[cavanoos]

Merhaba arkadaşlar;

Listemde filtre oluşturuyorum.Belli bir sütunda,"YANLIŞ" kelimesine eşit olmayanları listeliyorum.Çıkan sonucu başka bir sekmeye kopyalıyorum.Bütün bunları makro ile yapıyorum.Makro yaparken sıkıntı olmuyor.Makro bitince,makroyu çalıştırdığımda "YANLIŞ" ifadelerininde geldiğini görüyorum.

Ekli dosyamda bir liste hazırladım.makro kodum aşağıdadır.

Yardım edebilir misiniz ?

sub deneme()

Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$5000").AutoFilter Field:=5, Criteria1:= _
"<>YANLIŞ", Operator:=xlAnd
Range("A2:E2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Mağaza Pos Tutarları").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E15").Select
Selection.End(xlDown).Select
Columns("A:A").Select
Range("A2726").Activate
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
Range("A2739").Select
Selection.End(xlUp).Select
Columns("B:B").ColumnWidth = 34.14
Columns("B:B").ColumnWidth = 51
Columns("D").Select
Selection.Delete Shift:=xlToLeft
Selection.ColumnWidth = 20.14
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "TARİH"
Range("B1").Select
ActiveCell.FormulaR1C1 = "AÇIKLAMA"
Range("C1").Select
ActiveCell.FormulaR1C1 = "TUTAR"
Range("D1").Select
ActiveCell.FormulaR1C1 = "MAĞAZA ADI"
Range("D2").Select
Sheets("Ekstre Çalışması").Select
Range("A2912").Select
Selection.End(xlUp).Select

End Sub

 

[cavanoos]

Arkadaşlar;

Kimse bilmiyormu ya

Peki şöyle bir şey yapılabilir mi ?

Seçilen bir alanda,belli bir sütunda,belli bir kelime bulunan satırın dışındaki diğer satırları başka ir sekmeye kopyalaya bilir miyiz ?

 

[Korhan Ayhan]

Selamlar,

Mutlaka bilen birileri vardır. Fakat örnek dosya olmadığı için kimseler uğraşmak istemiyor.

 

[Huseyinkis]

Arkadaşlar;

Kimse bilmiyormu ya

Peki şöyle bir şey yapılabilir mi ?

Seçilen bir alanda,belli bir sütunda,belli bir kelime bulunan satırın dışındaki diğer satırları başka ir sekmeye kopyalaya bilir miyiz ?

Seçili alanı ve sutunu sizmi belirticeksiniz yani bir tablonun içerisinde 20 ile 40 satır arası gibi?

 

[cavanoos]

Dosya eklemeyi unutmuşum kusura bakmayın.

Basit bir örnek dosyası ekliyorum.

Seçili alanı ben belirtecem.A1500 gibi bir şey olucak.Bu alan içinde arayacak diyelim.

 

[Huseyinkis]

Dosya eklemeyi unutmuşum kusura bakmayın.

Basit bir örnek dosyası ekliyorum.

Seçili alanı ben belirtecem.A1500 gibi bir şey olucak.Bu alan içinde arayacak diyelim.

ekteki dosyayı incelermisiniz.

 

[cavanoos]

Hüseyin Bey;

Ekli dosyanızı açamadım.Okunmayan içerik hatası alıyorum.Açınca da bir şey çıkmıyor...

 

[Huseyinkis]

Hüseyin Bey;

Ekli dosyanızı açamadım.Okunmayan içerik hatası alıyorum.Açınca da bir şey çıkmıyor...

97 formatına donusturdum.. bunu açmayı denermisiniz.

 

[cavanoos]

Hüseyin Bey,

Dosyanızı açtım.Ama makro kodu oluşturmuşsunuz galiba.Onu açamıyorum.Makrolar devre dışı diyiyor.İlginç çünkü diğer makrolarım açılıyor.Makro kodunu mesaj olarak atar mısınız ?

 

[Huseyinkis]

Hüseyin Bey,

Dosyanızı açtım.Ama makro kodu oluşturmuşsunuz galiba.Onu açamıyorum.Makrolar devre dışı diyiyor.İlginç çünkü diğer makrolarım açılıyor.Makro kodunu mesaj olarak atar mısınız ?

F1 Hücresine süzmesini istedişiniz açıklamayı yazınız ben YANLIŞ diye yazmıştım

Sub aaA()
For i = Range("B65536").End(3).Row To 2 Step -1
If Cells(i, 2).Value <> Cells(1, 6).Value Then
son = Range("K65536").End(3).Row + 1
Cells(son, "K").Value = Cells(i, 1).Value
Cells(son, "L").Value = Cells(i, 2).Value
Cells(son, "M").Value = Cells(i, 2).Value
Range(Cells(i, 1), Cells(i, 3)).Select
Selection.Delete Shift:=xlUp
End If
Next
End Sub

 

[cavanoos]

Hüseyin Bey;

Elinize sağlık.Tam istediğim gibi.Teşekkürler...

 

[cavanoos]

Hüseyin Bey;

Aynı mantıkla bu sefer tutarı - karakterli rakamları listeden çıkartıp bir başka yere kopyalayabilir miyiz ?