Filter a range of cells with headers and data based on a criteria and construct a Table (VBA)

MAngosto 

Try this:

Sub FilteredTable()
    Dim sw As Worksheet
    Dim tw As Worksheet
    Dim sr As Long
    Dim m As Long
    Dim sc As Long
    Dim n As Long
    Dim tr As Long
    Dim tc As Long
    Dim rg As Range
    Dim f As Boolean
    Application.ScreenUpdating = False
    Set sw = ActiveSheet
    m = sw.Range("B4").End(xlDown).Row
    n = sw.Range("C3").End(xlToRight).Column
    Set rg = sw.Range("O3").CurrentRegion
    Set tw = Worksheets.Add(After:=sw)
    tw.Range("B2").Value = "Product"
    tr = 2
    For sr = 4 To m
        If Application.VLookup(sw.Cells(sr, 2).Value, rg, 2, False) = "True" Then
            tr = tr + 1
            tw.Cells(tr, 2).Value = sw.Cells(sr, 2).Value
            tc = 2
            For sc = 3 To n
                If Application.VLookup(sw.Cells(3, sc), rg, 2, False) = "True" Then
                    tc = tc + 1
                    If Not f Then
                        tw.Cells(2, tc).Value = sw.Cells(3, sc).Value
                        If sc = n Then
                            f = True
                        End If
                    End If
                    sw.Cells(sr, sc).Copy Destination:=tw.Cells(tr, tc)
                End If
            Next sc
            
        End If
    Next sr
    tw.ListObjects.Add Source:=tw.Range("B2").CurrentRegion, XlListObjectHasHeaders:=xlYes
    Application.ScreenUpdating = True
End Sub