如何仅复制Excel中E6下方的可见行而非所有行？

原代码会遍历E列第6行到最后一行的所有单元格（包括筛选隐藏行），要实现仅复制E6下方的可见行，需调整行遍历逻辑，只处理可见单元格，修改后的代码如下：

Option Explicit

Sub copyrows()
    Const TARGET_WB = "C:\desktop\result.xlsx"
    
    Dim wb As Workbook
    Dim wsSrc As Worksheet, ws As Worksheet
    Dim dict As Object, k, rng As Range, cell As Range
    Dim lastrow As Long
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set wsSrc = ThisWorkbook.Sheets("Sheet1")
    
    With wsSrc
        lastrow = .Cells(.Rows.Count, "E").End(xlUp).Row
        ' 仅遍历E列第7行到最后一行的可见单元格（跳过E6表头）
        For Each cell In .Range("E7:E" & lastrow).SpecialCells(xlCellTypeVisible)
            k = Trim(cell.Value)
            Set rng = .Range("C" & cell.Row & ":F" & cell.Row) ' 定位当前可见行的C-F列范围
            If dict.exists(k) Then
                Set dict(k) = Union(dict(k), rng)
            ElseIf Len(k) > 0 Then
                Set dict(k) = rng
            End If
        Next cell
    End With
    
    ' 复制到目标工作簿对应工作表
    Set wb = Workbooks.Open(TARGET_WB)
    For Each ws In wb.Sheets
        k = ws.Name
        If dict.exists(k) Then
            Set rng = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
            Debug.Print k, rng.Address
            dict(k).Copy rng
            dict.Remove k
        End If
    Next ws
End Sub

核心修改说明： #

• 替换原有的逐行循环，改用SpecialCells(xlCellTypeVisible)直接获取E列第7行到最后一行的可见单元格，自动跳过筛选隐藏的行。
• 通过cell.Row直接定位当前可见单元格所在行，精准获取对应行的C-F列范围，避免原代码中Offset可能引发的定位错误。
• 从E7开始遍历，直接排除作为筛选表头的E6单元格，无需额外判断。

内容的提问来源于stack exchange，提问作者line hitch