Soru Birden fazla değeri aratıp aynı anda silmek

[Necdet]

Merhaba,

Kodlar iki ayrı Sub'dan oluştuğu için ekran güncellemesi yapıyor.
Tek bir Sub haline getirdim.

Aşağıdaki kodları deneyiniz.

Sub VeriSil()
    
    Dim Syf As Worksheet, _
        ShS As Worksheet, _
        c   As Range, _
        Adr As String, _
        i   As Long, _
        j   As Long, _
        k   As Long, _
        Sat As Long, _
        ASh As String
    
    On Error Resume Next
    ASh = ActiveSheet.Name
    
    Set ShS = Sheets("Silinecekler")
    k = ShS.Cells(Rows.Count, "A").End(3).Row
    
    Application.ScreenUpdating = False
    
    For Each Syf In Worksheets
    
        Syf.Select
        If Syf.Name = "REVİZYON" Or Syf.Name = "DEPLASE" Or _
            Syf.Name = "METRO" Or Syf.Name = "FİBERKENT" Or _
            Syf.Name = "GREENFİELD" Or Syf.Name = "DEMONTAJ" Or _
            Syf.Name = "HASAR&BAKIM" Or Syf.Name = "TASLAK" Then
        
            Syf.Range("K2") = "X"
            For i = 2 To k
            
                With Syf.Range("B:B")
                    Set c = .Find(ShS.Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
                    If Not c Is Nothing Then
                        Adr = c.Address
                        Do
                            Sat = c.Row
                            Syf.Cells(Sat, "K") = 1
                            Set c = .FindNext(c)
                        Loop While Not c Is Nothing And c.Address <> Adr
                    End If
                End With
            
            Next i
            
            'Belirlenen satırlar süzdürülür ve silinir
            If Syf.AutoFilterMode = True Then Syf.Range("A2").AutoFilter
            j = Syf.Cells(Rows.Count, "A").End(3).Row
            
            Syf.Range("A2:K" & j).AutoFilter Field:=11, Criteria1:="<>"
            Syf.Range("A2:K$" & j).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        
            Syf.Columns("K:K").Delete
            Syf.Range("K2").Select
        
Son:
            If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
                
        End If
        
    Next Syf
    
    Sheets(ASh).Select
    
    Application.ScreenUpdating = True
    
End Sub

Süzülen_Verileri_Sil kodlarını silebilirsiniz. Bu kodlar mevcut kodun içine gömüldü.

 

[ruhadam26]

evet kendim öyle yapmaya calismistim zaten de olmamıştı tekrardan emeğinize sağlık çok iyi oldu böyle

 

[Necdet]

Güle güle kullanın.