Macro to dynamically copy new data and delete data from dynamic height

[earthworm]

I am trying to create dynamic macro if the data set does not contain the value Rizwan then copy paste it somewhere else , and then remove the data containing Rizwan from the source data . the height of data can vary and sequence is also not guranteed. how to make the macro dynamic i tried relative and absolute and made some minor modification but still i am not sure and data seems to be deleting other cells . i only need to remove filtered data keeping other data behind filter intact .


Range("F4:I4").Select
Selection.AutoFilter
Range("G4").Select
ActiveSheet.Range("$F$4:$I$12").AutoFilter Field:=2, Criteria1:="<>Rizwan" _
, Operator:=xlAnd
Range("F4:I4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("J18").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
Range("F4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Range("G4").Select
ActiveSheet.Range("$F$4:$I$12").AutoFilter Field:=2, Criteria1:="=Rizwan", _
Operator:=xlAnd
Range("F4").Select
ActiveCell.Offset(2, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Range("A1").Select
End Sub

 

[Fluff]

Untested, but try

   Dim UsdRws As Long
   
   With ActiveSheet
      If .AutoFilterMode Then .AutoFilterMode = False
      UsdRws = Range("G" & Rows.count).End(xlUp).Row
      .Range("G4").AutoFilter 1, "<>Rizwan"
      .Range("F4:I" & UsdRws).SpecialCells(xlVisible).Copy .Range("J" & UsdRws + 10)
      .Range("G4").AutoFilter 1, "=Rizwan"
      .Range("F4:I" & UsdRws).SpecialCells(xlVisible).Delete xlUp
      .AutoFilterMode = False
      .Range("A1").Select
   End With

 

[earthworm]

code is only pasting data to other cell but not deleting

 

[Fluff]

Ok, try

Sub chk()
   Dim UsdRws As Long
   
   With ActiveSheet
      If .AutoFilterMode Then .AutoFilterMode = False
      UsdRws = Range("G" & Rows.count).End(xlUp).Row
      .Range("G4:G" & UsdRws).AutoFilter 1, "<>Rizwan"
      .Range("F4:I" & UsdRws).SpecialCells(xlVisible).Copy .Range("J" & UsdRws + 10)
      .Range("G4").AutoFilter 1, "=Rizwan"
      .Range("F4:I" & UsdRws).SpecialCells(xlVisible).Delete xlUp
      .AutoFilterMode = False
      .Range("A1").Select
   End With
End Sub