Apply Filter and cut and paste to new spreadsheet

[JoeRooney]

Hi,

Wondering if someone could help me with some code I need to apply a filter , cut the visible rows and paste into a new sheet.

I then want to return to the original sheet and delete the blank rows.

When I record it records the exact ranges , If someone could advise me how to do it without naming specific ranges that would be great.

I need to filter column P , for “00GHT” , my current code is below.

Any help is greatly appreciated

  Rows("3:3").Select
    Selection.AutoFilter
    ActiveWindow.SmallScroll ToRight:=4
    ActiveSheet.Range("$A$3:$AEN$5386").AutoFilter Field:=16, Criteria1:= _
        "00GHT"
    Rows("1:1").Select
    Range("E1").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.copy
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Rows("21:21").Select
    Range("E21").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Range("E4").Select

 

[Fluff]

How about

With ActiveSheet
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A3:AEN3").AutoFilter 16, "00GHT"
    .AutoFilter.Range.Offset(1).Copy Sheets("Sheet1").Range("A1")
    .AutoFilter.Range.Offset(1).Delete
    .AutoFilterMode = False
End With

 

[JoeRooney]

Thank you, works perfectly , just had to make a few small adjustments final code below:

Sub Filter()

    Sheets("POL").Select
    With ActiveSheet
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A3:AEN3").AutoFilter 16, "00GHT"
    .AutoFilter.Range.Offset(1).copy Sheets("Sheet1").Range("A1")
    .AutoFilter.Range.Offset(-2).copy
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("POL").Select
    .AutoFilterMode = False
End With

With ActiveSheet
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A3:AEN3").AutoFilter 16, "00GHT"
    .AutoFilter.Range.Offset(1).Delete
    .AutoFilterMode = False
    
    End With

End Sub

 

[Fluff]

You're welcome & thanks for the feedback