Sub EE_FilterAndCopyToNewSheet(rngTable As range, strHeading As String, strCriteria As String, strCopyToSheet As String, Optional blnAppendToExistingSheet As Boolean = True)
'- same as filter and remove, but instead copies results to a new sheet
'- replaces the sheet if it exists already
    Dim intHeadCol      As Integer
    Dim wksTgt          As Worksheet
    Dim wbk             As Workbook
    Dim rngData         As range
    Dim rngTgt          As range
 
'http://excelexperts.com/xla-routines-eeFilterAndCopyToNewSheet    for updates on this sub routine

    intHeadCol = Application.WorksheetFunction.Match(strHeading, rngTable.Rows(1), 0)
    Set rngData = Intersect(rngTable, rngTable.Offset(1))
 
    If rngTable.Parent.AutoFilterMode = True Then rngTable.Parent.AutoFilterMode = False
 
    rngTable.AutoFilter Field:=intHeadCol, Criteria1:=strCriteria
 
    Set wbk = rngTable.Parent.Parent
    On Error Resume Next
    If EE_SheetExists(strCopyToSheet, wbk) Then
        Set wksTgt = wbk.Worksheets(strCopyToSheet)
        If wksTgt.range("A1").value = vbNullString Then
            Set rngTgt = wksTgt.range("A1")
            rngTable.SpecialCells(xlCellTypeVisible).Copy
        Else
            Set rngTgt = wksTgt.Cells(Rows.Count, "A").End(xlUp).Offset(1)
            rngData.SpecialCells(xlCellTypeVisible).Copy
        End If
        'Call EE_DeleteSheet(wksTgt)
    Else
        Set wksTgt = wbk.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wksTgt.Name = strCopyToSheet
        Set rngTgt = wksTgt.range("A1")
        rngTable.SpecialCells(xlCellTypeVisible).Copy
    End If
 
    'Paste
    rngTgt.PasteSpecial xlPasteAll
    Err.Clear: On Error GoTo 0: On Error GoTo -1
 
    Application.CutCopyMode = False
 
    'Clear Filter
    If rngTable.Parent.AutoFilterMode = True Then rngTable.Parent.AutoFilterMode = False
 
    Set rngData = Nothing
    Set rngTgt = Nothing
    Set wksTgt = Nothing
    Set wbk = Nothing
End Sub