如何按性别筛选并复制指定行至新Excel工作表

核心错误（直接导致你的问题） #

你代码里的嵌套循环存在致命逻辑漏洞：

• 仅在进入While循环时选中了Bsd.Cells(N,1)，后续Do循环中N不断递增，但没有重新定位到新的行，导致所有循环都在判断**同一行（初始的第2行）**的性别值。
• 比如如果第2行是Male，选择Male时会重复复制这一行；选择Female时，因为第2行不匹配，所以没有任何内容被复制。

其他次要问题 #

• 循环重复嵌套：外层While N <> NR和内层Do Loop Until N = NR逻辑冲突，导致循环控制混乱
• 总行数计算错误：NR = Bsd.Range("a1").End(xlDown).Row - 1会排除主表最后一行数据
• 依赖Select/ActiveCell：操作不稳定，容易因工作表切换或用户操作导致逻辑出错
• 空行查找效率极低：嵌套Do循环逐行找空行，大表格会卡顿
• 未处理工作表重名：如果已存在"Teste"工作表，运行代码会直接报错

修复后的代码 #

Sub Selection()
    Dim CatDes As String
    Dim Bsd As Worksheet
    Dim Tst As Worksheet
    Dim lastRow As Long
    Dim targetRow As Long
    Dim i As Long
    
    ' 获取用户选择的性别，Trim去除前后空格避免匹配失败
    CatDes = Trim(Sheets("issue sheet").Range("B2").Value)
    ' 绑定主数据工作表
    Set Bsd = ThisWorkbook.Worksheets("Base de dados")
    
    ' 获取主表最后一行（用UsedRange避免中间空行导致的判断错误）
    lastRow = Bsd.UsedRange.Rows(Bsd.UsedRange.Rows.Count).Row
    
    ' 处理目标工作表：避免重名错误，存在则清空内容，不存在则新建
    On Error Resume Next
    Set Tst = ThisWorkbook.Worksheets("Teste")
    If Err.Number <> 0 Then
        ' 新建工作表并命名
        Set Tst = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        Tst.Name = "Teste"
    Else
        ' 清空已有数据（保留表头）
        Tst.Rows("2:" & Tst.UsedRange.Rows.Count).ClearContents
    End If
    On Error GoTo 0
    
    ' 复制表头到目标表
    Bsd.Range("A1", Bsd.Cells(1, Bsd.UsedRange.Columns.Count)).Copy
    Tst.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False ' 取消剪切板占用
    
    ' 初始化目标表的数据起始行（表头占第1行）
    targetRow = 2
    
    ' 遍历主表所有数据行（从第2行到最后一行）
    For i = 2 To lastRow
        ' 检查第5列（E列，对应原代码的Offset(0,4)）的性别是否匹配
        If Trim(Bsd.Cells(i, 5).Value) = CatDes Then
            ' 复制当前行的所有数据到目标表
            Bsd.Range(Bsd.Cells(i, 1), Bsd.Cells(i, Bsd.UsedRange.Columns.Count)).Copy
            Tst.Range("A" & targetRow).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            targetRow = targetRow + 1 ' 目标行下移一行
        End If
    Next i
    
    ' 自动调整目标表列宽，提升可读性
    Tst.Columns.AutoFit
End Sub

关键优化说明 #

• 简化循环逻辑：用For i = 2 To lastRow直接遍历所有数据行，彻底避免嵌套循环的混乱
• 修复单元格定位：直接通过Bsd.Cells(i,5)引用性别列，不再依赖Select/ActiveCell，逻辑稳定
• 修正总行数计算：用UsedRange获取最后一行，不会因为中间空行导致漏数据
• 处理重名问题：自动判断并处理"Teste"表的存在情况，避免运行报错
• 增加空格处理：用Trim()去除性别值的前后空格，避免因输入空格导致匹配失败
• 提升效率：复制后立即取消剪切板模式，减少内存占用；直接定位目标行，无需逐行查找空行

内容的提问来源于stack exchange，提问作者Matheus Lors