süzüleni kesme

[maviayna]

Dostlarıma uzun zamandan sonra merhaba.
Aşağıdaki kodlar sayesinde istediğim verileri süzüyorum. Ancak çok sayıda olan verilerdeki yazım yanlışlıkları yüzünden her zaman doğru sonuçları alamıyorum (hele bir muhasebeciyseniz devlete yanlış beyanda bulunmak ne demektir!).

Private Sub TextBox2_Change()
On Error Resume Next
METİN1 = TextBox2.Value
Set FC2 = Range("B7:J65000").Find(What:=METİN1)
Application.Goto Reference:=Range(FC2.Address), _
   Scroll:=False
Selection.AutoFilter Field:=2, Criteria1:="*" & TextBox2.Value & "*"
If METİN1 = "" Then
Selection.AutoFilter Field:=2
End If
End Sub

Sorunu çözmek için süzülen veriyi bir butona basıp kesmek yeterli olur ki kalan verilere bakıp yazım yanlışlığı olan satırları gözle görebileyim.
Yani ilk olarak doğruları süzüp(ki görmek için kalabalık yapmasınlar) yanlışları ayıklayayım. Umarım anlatabilmişimdir.
Sitemizde bu konuyla ilgili kodlara rastlayamadım.
AdvancedFilter yöntemi anladığım kadarıyla sadece kopyalıyor, kesme işi yok.
Elleriniz dert görmesin.

 

[Levent Menteşoğlu]

Merhaba tekrar hoşgeldiniz.

Kesmekten kastınızı anlayamadım. Bir örnek dosya üzerinde izah edermisiniz.

 

[maviayna]

Teşekkür ederim üstadım.

Dosyayı ekledim. Açıklaması da;
Örneğin sayfa1 deki kayıtlar arasında ISISAN isimli firmamızı arıyoruz. Tekboxla süzdükten sonra butona basarak ısısanla ilgili satırları 2.sayfaya atmak istiyorum. Diğer firmalarıda aynı şekilde süzüp ilgili sayfalara butonla gönderdikten sonra(ki bu gönderilenler 1.sayfada kalmamalı) 1. sayfada geriye kalan satırları gözle inceleyip(ki genelde yazım hatası olanlar kalıyor) hangi firmaya aitse o sayfaya göndermek istiyorum.

Özet olarak ISISAN'ı süzdükten sonra ısısanla ilgili satırlar 1.sayfada kalmamak şartıyla butonla 2. sayfaya göndermek isityorum.
Bir firma için yapabilirsek diğer firmaları yapabilirim.
Tekrar teşekkür ederim

 

[maviayna]

Sayın Leventm ekli dosyayı farkettiniz mi? Saygılar.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Private Sub CommandButton1_Click()
Sheets.Add.Move after:=Sheets(Sheets.Count)
ActiveSheet.Name = TextBox2
Sheets("veri").[a4].CurrentRegion.Copy
Sheets(Sheets.Count).PasteSpecial
Application.CutCopyMode = False
Range("A4:A" & [a65536].End(3).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
TextBox2 = ""
End Sub

 

[maviayna]

Üstadım tek kelimeyle harikasınız.
Başka da birşey demiyorum.