Check the value before filtering

[sofas]

Welcome . I want to set the condition for verifying the word YES before filtering. If it does not exist, it is ignored. If the condition is met, the filter will be executed, and the same thing with the word ok With the possibility of executing it on the existing element only

Public Sub drewhx15()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim Rng As Range
  Dim lr As Long, lr2 As Long

  Set sh1 = ThisWorkbook.Worksheets("feuil1")
  Set sh2 = ThisWorkbook.Worksheets("Sh")
 
  With sh1
    Set Rng = .Range("b5:d" & .Cells(.Rows.Count, "A").End(xlUp).Row)
  End With
  With Rng
    .AutoFilter Field:=1, Criteria1:="ok"
    lr = sh2.Range("B" & Rows.Count).End(3).Row + 1
    .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("B" & lr)
    lr2 = sh2.Range("B" & Rows.Count).End(3).Row
    sh2.Range("D" & lr & ":D" & lr2).Value = sh1.Range("M2").Value
  
    .AutoFilter Field:=1, Criteria1:="yes"
    lr = sh2.Range("F" & Rows.Count).End(3).Row + 1
    .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("F" & lr)
    lr2 = sh2.Range("F" & Rows.Count).End(3).Row
    sh2.Range("H" & lr & ":H" & lr2).Value = sh1.Range("M2").Value
  
    .Parent.AutoFilterMode = False
  End With
End Sub

 

[DanteAmor]

How about:

Public Sub drewhx15()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim Rng As Range, f As Range
  Dim lr As Long, lr2 As Long

  Set sh1 = ThisWorkbook.Worksheets("feuil1")
  Set sh2 = ThisWorkbook.Worksheets("Sh")
 
  With sh1
    Set Rng = .Range("b5:d" & .Cells(.Rows.Count, "A").End(xlUp).Row)
  End With
  With Rng
    Set f = .Columns(1).Find("ok", , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      .AutoFilter Field:=1, Criteria1:="ok"
      lr = sh2.Range("B" & Rows.Count).End(3).Row + 1
      .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("B" & lr)
      lr2 = sh2.Range("B" & Rows.Count).End(3).Row
      sh2.Range("D" & lr & ":D" & lr2).Value = sh1.Range("M2").Value
    End If
    
    Set f = .Columns(1).Find("yes", , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      .AutoFilter Field:=1, Criteria1:="yes"
      lr = sh2.Range("F" & Rows.Count).End(3).Row + 1
      .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("F" & lr)
      lr2 = sh2.Range("F" & Rows.Count).End(3).Row
      sh2.Range("H" & lr & ":H" & lr2).Value = sh1.Range("M2").Value
    End If
    
    .Parent.AutoFilterMode = False
  End With
End Sub

 

[Alex Blakenburg]

Not sure what you mean by the last phrase but another option:
(repeat for yes)

  With Rng
    Dim cntCrit As Long                         ' Move to the Dim area
    cntCrit = WorksheetFunction.CountIfs(Rng.Columns(1), "ok")
    
    If cntCrit <> 0 Then
        .AutoFilter Field:=1, Criteria1:="ok"
        lr = sh2.Range("B" & Rows.Count).End(3).Row + 1
        .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("B" & lr)
        lr2 = sh2.Range("B" & Rows.Count).End(3).Row
        sh2.Range("D" & lr & ":D" & lr2).Value = sh1.Range("M2").Value
    End If

 

[DanteAmor]

Hi @sofas , if you want to know more about the Find method:

---

---

 

[sofas]

How about:

Public Sub drewhx15()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim Rng As Range, f As Range
  Dim lr As Long, lr2 As Long

  Set sh1 = ThisWorkbook.Worksheets("feuil1")
  Set sh2 = ThisWorkbook.Worksheets("Sh")
 
  With sh1
    Set Rng = .Range("b5:d" & .Cells(.Rows.Count, "A").End(xlUp).Row)
  End With
  With Rng
    Set f = .Columns(1).Find("ok", , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      .AutoFilter Field:=1, Criteria1:="ok"
      lr = sh2.Range("B" & Rows.Count).End(3).Row + 1
      .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("B" & lr)
      lr2 = sh2.Range("B" & Rows.Count).End(3).Row
      sh2.Range("D" & lr & ":D" & lr2).Value = sh1.Range("M2").Value
    End If
   
    Set f = .Columns(1).Find("yes", , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      .AutoFilter Field:=1, Criteria1:="yes"
      lr = sh2.Range("F" & Rows.Count).End(3).Row + 1
      .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("F" & lr)
      lr2 = sh2.Range("F" & Rows.Count).End(3).Row
      sh2.Range("H" & lr & ":H" & lr2).Value = sh1.Range("M2").Value
    End If
   
    .Parent.AutoFilterMode = False
  End With
End Sub

Thank you.Very useful clips...
Frankly, all credit is due to you. I only needed some additions, so that the code was executed despite the absence of the target value, which leads to the loss of the file format. Really, thank you