Filter the data and copy it to another sheet with conditions

[sofas]

Hello, I want to filter column A on a specific value and copy the data to another sheet so that the data is pasted info b12 . For example, the problem we are facing is that I want to copy the value of cell M2 from sheet 1 to sheet 2 next to the transferred values and with the same number of rows that were filtered and transferred.
in column A and E
And when re-continuous again is copying down the old data

Public Sub drewhx15()
Dim Rng As Range

With ThisWorkbook.Worksheets("feuil1")
Set Rng = .Range("b5:d" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
With Rng
.AutoFilter Field:=1, Criteria1:="ok"
.Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy ThisWorkbook.Worksheets("Sh").Range("b12")
.AutoFilter Field:=1, Criteria1:="yes"
.Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy ThisWorkbook.Worksheets("Sh").Range("F12")
.Parent.AutoFilterMode = False
End With
End Sub

 

[DanteAmor]

I want to copy the value of cell M2 from sheet 1 to sheet 2 next to the transferred values

I hope I have understood correctly, try the following:

Public Sub drewhx15()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim Rng As Range
  Dim lr 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"
    .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("b12")
    lr = sh2.Range("B" & Rows.Count).End(3).Row
    sh2.Range("D12:D" & lr).Value = sh1.Range("M2").Value
    
    .AutoFilter Field:=1, Criteria1:="yes"
    .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("F12")
    lr = sh2.Range("F" & Rows.Count).End(3).Row
    sh2.Range("H12:H" & lr).Value = sh1.Range("M2").Value
    
    .Parent.AutoFilterMode = False
  End With
End Sub

 

[sofas]

I hope I have understood correctly, try the following:

Public Sub drewhx15()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim Rng As Range
  Dim lr 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"
    .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("b12")
    lr = sh2.Range("B" & Rows.Count).End(3).Row
    sh2.Range("D12:D" & lr).Value = sh1.Range("M2").Value
   
    .AutoFilter Field:=1, Criteria1:="yes"
    .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy sh2.Range("F12")
    lr = sh2.Range("F" & Rows.Count).End(3).Row
    sh2.Range("H12:H" & lr).Value = sh1.Range("M2").Value
   
    .Parent.AutoFilterMode = False
  End With
End Sub

Always creative, thank you very much. Is there a possibility to keep the old data and copy the new ones below it?

 

[DanteAmor]

Try :

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

 

[sofas]

Try :

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

Very nice job thank you very much.