Search columns and paste rows

Public Sub FilterData()
Dim rngArea As Range, xlCalc As XlCalculation
On Error GoTo Handler
With Application
    xlCalc = Application.Calculation
    .Calculation = xlCalculationManual
    .Application.ScreenUpdating = False
    .EnableEvents = False
End With
Sheets("sheet2").Columns(1).Clear
Sheets("Sheet1").Select
With Range(Cells(1, Columns.Count), Cells(Rows.Count, "A").End(xlUp).Offset(, Columns.Count - 1))
    .FormulaR1C1 = "=IF(RC2=4,1,""x"")"
    For Each rngArea In .SpecialCells(xlCellTypeFormulas, xlNumbers).Areas
        Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(rngArea.Rows.Count, 4).Value = rngArea.Offset(, 7 - Columns.Count).Resize(, 4).Value
    Next rngArea
    .Clear
End With
ExitPoint:
With Application
    .Calculation = xlCalc
    .Application.ScreenUpdating = True
    .EnableEvents = True
End With
Exit Sub

Handler:
MsgBox "Error etc...", vbCritical, "Error"
Resume ExitPoint

End Sub

Others may suggest Auto Filter... given the volume of data I don't know how feasible that is... I added in some Application events given that fact (re: calculation, screenupdating and events)