How to select and copy specific contents to other tables

i am trying to copy all the rows that are defined as "Male" or "Female" depending on the user's choice, as an study and test of concept for my job, however when i try to run the code it either repeats the first line for the amount of rows there are in the main table or it does not copy anything if i select "Female".

My code is:

    Sub Seletion()

Dim CatDes As String
Dim Bsd As Excel.Worksheet
Dim Tst As Excel.Worksheet
Dim NR As Integer
Dim i As Integer
Dim N As Integer

'Variables
CatDes = Sheets("issue sheet").Range("B2").Value
Set Bsd = Excel.Worksheets("Base de dados")
NR = Bsd.Range("a1").End(xlDown).Row - 1
N = 2

'Copy headers
Bsd.Select
Range("A1", Range("A1").End(xlToRight)).Copy
Sheets.Add.Name = "Teste"
    'Criar planilha nova
        Set Tst = Excel.Worksheets("Teste")
        Tst.Range("A1").PasteSpecial Paste:=xlPasteValues

'Copy info
While N <> NR

Bsd.Select
Bsd.Cells(N, 1).Select
    Do
        If ActiveCell.Offset(0, 4).Value = CatDes Then
            Range(ActiveCell, Cells(ActiveCell.Row, ActiveCell.End(xlToRight).Column)).Copy
            Tst.Select
            Range("A1").Select
                'Checar Próxima Celula Vazia
            Do While Not IsEmpty(ActiveCell)
                ActiveCell.Offset(1, 0).Select
            Loop
            ActiveCell.PasteSpecial xlPasteValues
            Else
        End If
        N = N + 1
    Loop Until N = NR
Wend
    
End Sub

The idea is that i:

1. Have the Gender i want selected/Typed (CatDes)
2. Know how many rows there are in the main database (NR)
3. Copy the Headers of the Main database (Since i am aiming to create a new sheet as a whole rather than filtering it)
4. Copy all rows that have the exact gender i selected.

I tried to repeat the checking gender process as many times as there are rows in the main database but i'm not sure if there is a better way for it, hence the "N<>NR" I tried using the For I ... Next but had no success. Any help is apreciated

Copy Filtered Rows As Values

Sub CopyFilteredValues()

    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Retrieve the criteria from the lookup sheet.
    Dim lws As Worksheet: Set lws = wb.Sheets("Issue Sheet")
    Dim Criteria As String: Criteria = CStr(lws.Range("B2").Value)
    
    ' Return the values of the source table range in an array.
    Dim sws As Worksheet: Set sws = wb.Sheets("Base de dados")
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
    Dim sRowsCount As Long: sRowsCount = srg.Rows.Count
    Dim ColumnsCount As Long: ColumnsCount = srg.Columns.Count
    If ColumnsCount < 5 Then Exit Sub ' 5 is the criteria column
    Dim Data() As Variant: Data = srg.Value
    Dim IsHeaderRow As Boolean: IsHeaderRow = True
    
    ' Declare addtional variables.
    Dim sRow As Long, dRow As Long, Col As Long, AreRowsDifferent As Boolean
    
    ' Loop through the rows of the array and move the matching rows
    ' to the top.
    For sRow = 1 To sRowsCount
        If IsHeaderRow Then
            dRow = dRow + 1
            IsHeaderRow = False
        Else
            If StrComp(CStr(Data(sRow, 5)), Criteria, vbTextCompare) = 0 Then
                dRow = dRow + 1
                If Not AreRowsDifferent Then
                    If dRow < sRow Then AreRowsDifferent = True
                End If
                If AreRowsDifferent Then
                    For Col = 1 To ColumnsCount
                        Data(dRow, Col) = Data(sRow, Col)
                    Next Col
                End If
            End If
        End If
    Next sRow
    
    ' Add or clear the destination sheet.
    Dim dws As Worksheet:
    On Error Resume Next
        Set dws = wb.Sheets("Teste")
    On Error GoTo 0
    If dws Is Nothing Then
        Set dws = wb.Sheets.Add
        dws.Name = "Teste"
    Else
        dws.Cells.Clear
    End If
    
    ' Copy the values from the top of the array to the destination sheet.
    dws.Range("A1").Resize(dRow, ColumnsCount).Value = Data
    
    ' Inform.
    If dRow = 1 Then
        MsgBox "No rows matching """ & Criteria & """ found!", vbExclamation
    Else
        MsgBox "Copied rows matching """ & Criteria & """.", vbInformation
    End If
    
End Sub