Having trouble with autofilter code

[THRASHER69]

I have a sheet that I want to filter out different parts to other sheets in the workbook. I can't seem to get the code right to do what I need. On my "Orderless Original" sheet in column A there will be a header in A1 that is "Planner". Right under that in A2 has the "BHTDB" that I am needing to filter. Then there will be anywhere from 1 - 30 cells under that that are blank. Other information is in B:L. Everyplace there is BHTDB I need to copy the row above which will have planner in it, and all the rows below until it reaches the Planner again. Here is a sample of the spreadsheet plus the code I am using.

[TABLE="width: 707"]
<tbody>[TR]
[TD]Planner[/TD]
[TD]AM[/TD]
[TD]Product number[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]BHTDB[/TD]
[TD]A2[/TD]
[TD="align: right"]11600068[/TD]
[TD]1.5"SET OF COMP"H"CONE PKG[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.5"SET OF COMP"H"CONE PKG[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.5"SET OF COMP"H"CONE PKG[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.5"SET OF COMP"H"CONE PKG[/TD]
[/TR]
[TR]
[TD]Planner[/TD]
[TD]AM[/TD]
[TD]Product number[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]BSHIP[/TD]
[TD][/TD]
[TD]11601010X[/TD]
[TD]1.12"SET-COMP"C-X"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"C-X"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"C-X"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"C-X"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD]BSHIP[/TD]
[TD][/TD]
[TD]11601010X[/TD]
[TD]1.12"SET-COMP"C-X"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"C-X"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"C-X"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"C-X"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD]Planner[/TD]
[TD]AM[/TD]
[TD]Product number[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]BHTDB[/TD]
[TD]A2[/TD]
[TD="align: right"]11611013[/TD]
[TD]1.12"SET-COMP"D"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"D"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"D"CONE PKG (5)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.12"SET-COMP"D"CONE PKG (5)[/TD]
[/TR]
</tbody>[/TABLE]

Sheets("Orderless Original").Activate    CriteriaStg = "BHTDB;TCOILE;BSHIP"
    SheetsStg = "BHTDB;TCOILE;BSHIP"
    CriteriaTbl = Split(CriteriaStg, ";")
    ShtTbl = Split(SheetsStg, ";")
     
    Sheets("Orderless Original").Activate
     
    For i = 0 To UBound(CriteriaTbl, 1)
        WkSht1 = ShtTbl(i)
        WkCriteria = CriteriaTbl(i)
        Sheets(WkSht1).Cells.ClearContents
        For Each rCell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
        If rCell = "Planner" Then ActiveSheet.AutoFilter field:=1, Criteria1:=WkCriteria
            ActiveSheet.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(WkSht1).Range("A1")
            ActiveSheet.AutoFilter field:=1
        Next rCell
    Next i

 

[THRASHER69]

The part in red is what I am having trouble wording right. Or maybe there is a better way to write the whole thing?

Sheets("Orderless Original").Activate        
    CriteriaStg = "BHTDB;TCOILE;BSHIP"
    SheetsStg = "BHTDB;TCOILE;BSHIP"
    CriteriaTbl = Split(CriteriaStg, ";")
    ShtTbl = Split(SheetsStg, ";")
     
Sheets("Orderless Original").Activate
     
    For i = 0 To UBound(CriteriaTbl, 1)
        WkSht1 = ShtTbl(i)
        WkCriteria = CriteriaTbl(i)
        Sheets(WkSht1).Cells.ClearContents
        [COLOR=#ff0000]For Each rCell In Range("A1", Cells(Rows.Count, "A").End(xlUp))[/COLOR]
[COLOR=#ff0000]        If rCell = "Planner" Then [/COLOR]
[COLOR=#ff0000]            ActiveSheet.AutoFilter field:=1, Criteria1:=WkCriteria[/COLOR]
[COLOR=#ff0000]            ActiveSheet.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(WkSht1).Range("A1")[/COLOR]
[COLOR=#ff0000]            ActiveSheet.AutoFilter field:=1[/COLOR]
[COLOR=#ff0000]        Next rCell[/COLOR]
    Next i