Excel VBA宏：打印表中「Follow Up?」列为Yes的行并解决格式与筛选问题

解决原有宏存在的两个核心问题：筛选状态下误打印隐藏行、频繁调用选中操作导致的格式异常，同时新增自动识别跟进标记的逻辑。

完整代码 #

Sub TransposeAndPrint_Fixed()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lLastRow As Long, lFollowUpCol As Long, i As Long
    ' 绑定数据源表和打印模板表，表名与原有逻辑保持一致
    Set wsSource = ThisWorkbook.Sheets("STEP")
    Set wsTarget = ThisWorkbook.Sheets("Sheet1")
    
    ' 自动匹配「Follow Up? (Yes, No)」列的位置
    lFollowUpCol = Application.Match("Follow Up? (Yes, No)", wsSource.Rows(1), 0)
    If IsError(lFollowUpCol) Then
        MsgBox "未找到「Follow Up? (Yes, No)」列，请检查表头拼写是否正确", vbCritical
        Exit Sub
    End If
    
    ' 读取数据源最后一行的行号
    lLastRow = wsSource.Cells(wsSource.Rows.Count, lFollowUpCol).End(xlUp).Row
    
    ' 遍历所有数据行，跳过表头行
    For i = 2 To lLastRow
        ' 仅处理未隐藏、且跟进标记为Yes的行，Yes不区分大小写
        If Not wsSource.Rows(i).Hidden And UCase(Trim(wsSource.Cells(i, lFollowUpCol).Value)) = "YES" Then
            ' 直接操作对象完成复制转置，不调用选中操作避免格式异常
            wsSource.Rows(i).Copy
            wsTarget.Range("B2").PasteSpecial Paste:=xlPasteAll, Transpose:=True
            Application.CutCopyMode = False
            ' 直接打印指定区域，无需提前选中
            wsTarget.Range("A1:B15").PrintOut Copies:=1, Collate:=True
        End If
    Next i
    MsgBox "所有需要跟进的行已处理完成", vbInformation
End Sub

关键优化说明 #

• 移除所有Select、Selection这类依赖界面选中状态的操作，直接操作工作表和单元格对象，彻底避免界面切换导致的格式异常、运行不稳定问题
• 自动识别跟进标记列位置，无需手动硬编码列号，只要表头正确即可正常运行
• 新增隐藏行判断逻辑，自动跳过筛选隐藏、手动隐藏的行，不会误打印不可见的中间行
• Yes匹配不区分大小写，不管用户输入的是yes/YES/Yes都可以命中规则
• 增加错误提示，表头缺失时可快速定位问题

如果你的表格表头不在第一行，修改代码中wsSource.Rows(1)和For i = 2的对应数值即可适配。

内容的提问来源于stack exchange，提问作者Eli Pritchard