Put the following code in a general module and run. You can download the attachment as well to see how it works.

Sub TestIt()

    Dim rngTgt As Range

    Dim arr

'Target where you want to see filtered data

    Set rngTgt = Sheet1.Range("J2")

    rngTgt.CurrentRegion.Offset(1).ClearContents

'Calling function with parameters

    arr = FilterRange(Sheet1.Range("A1").CurrentRegion, Sheet1.Range("F1"), Sheet1.Range("F2"), Sheet1.Range("G1"), Sheet1.Range("G2"), Sheet1.Range("H1"), Sheet1.Range("H2"))

    If Not IsEmpty(arr) Then

        rngTgt.Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1) = arr

    End If

End Sub

Function FilterRange(rngWithHeader As Range, ParamArray arrFldnCrit() As Variant) As Variant

'ParamArray arrFldnCrit - it should be field name then field value (criteria) e.g.

'Field1, Value1, Field2, Value2 and so on...

    Dim arrRng

    Dim i As Long

    Dim y As Integer

    Dim x As Integer

    Dim intCntCond As Integer

    Dim intCntMatch As Integer

    Dim lngLoopArr As Long

    intCntCond = (UBound(arrFldnCrit) + 1) / 2

    ReDim arrFld(0)

    ReDim arrCrit(0)

    ReDim arrfldcol(0)

    For i = LBound(arrFldnCrit) To UBound(arrFldnCrit)

        If i Mod 2 = 0 Then

            If i <> 0 Then ReDim Preserve arrFld(UBound(arrFld) + 1)

            arrFld(UBound(arrFld)) = arrFldnCrit(i)

        Else

            If i > 1 Then ReDim Preserve arrCrit(UBound(arrCrit) + 1)

            arrCrit(UBound(arrCrit)) = arrFldnCrit(i)

        End If

    Next i

    arrRng = rngWithHeader

    ReDim arrTemp(UBound(arrRng, 1) - 1, UBound(arrRng, 2) - 1)

    For y = LBound(arrFld) To UBound(arrFld)

        For i = LBound(arrRng, 2) To UBound(arrRng, 2)

            If arrFld(y) = arrRng(1, i) Then

                If y <> LBound(arrFld) Then

                    ReDim Preserve arrfldcol(UBound(arrfldcol) + 1)

                End If

                arrfldcol(UBound(arrfldcol)) = i

            End If

        Next i

    Next y

    y = 0

    For lngLoopArr = LBound(arrRng, 1) To UBound(arrRng, 1)

        intCntMatch = 0

        For i = 1 To intCntCond

            If arrRng(lngLoopArr, arrfldcol(i - 1)) = arrCrit(i - 1) Then

                intCntMatch = intCntMatch + 1

            End If

        Next i

        If intCntCond = intCntMatch Then

            y = y + 1

            For x = LBound(arrRng, 2) To UBound(arrRng, 2)

                arrTemp(y - 1, x - 1) = arrRng(lngLoopArr, x)

            Next x

        End If

    Next lngLoopArr

    If y = 0 Then Exit Function

    ReDim arrFinal(y - 1, UBound(arrRng, 2) - 1)

    For x = LBound(arrFinal, 1) To UBound(arrFinal, 1)

        For y = LBound(arrFinal, 2) To UBound(arrFinal, 2)

            arrFinal(x, y) = arrTemp(x, y)

        Next y

    Next x

    FilterRange = arrFinal

End Function