如何在同工作表中偏移复制粘贴筛选后的可见行

问题场景 #

原本可以将筛选后的可见行复制到其他工作表，但在同一张工作表内复制时出现报错，尝试了两种写法均失败：

原跨表可行代码：

With ws1.Range("A1:Q" & LastRow)
    .AutoFilter Field:=6, Criteria1:="Movies"
    Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Sheet1").Range("A1")
End With

尝试的同表写法1（报错）：

With ws1.Range("A1:Q" & LastRow)
    .AutoFilter Field:=6, Criteria1:="Movies"
    .Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws1.Range("A" & LastRow + 1)
End With

尝试的同表写法2（报错）：

With ws1.Range("A1:Q" & LastRow)
    .AutoFilter Field:=6, Criteria1:="Movies"
    .Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=ws1.Range("A" & LastRow + 1 & ":Q" & LastRow + LastRow2)
End With 

报错原因 #

1. 区域重叠冲突：同工作表复制时，筛选状态下的源可见区域与下方目标区域在Excel的区域逻辑中存在重叠（隐藏行也会被纳入区域判断），触发复制冲突报错。
2. 未定义变量：第二种写法中的LastRow2未声明赋值，导致目标区域地址无效。

解决办法 #

方法1：借助临时工作表中转

通过临时表避免同表区域冲突，步骤清晰可靠：

Sub CopyVisibleToSameSheet()
    Dim ws1 As Worksheet, tempWs As Worksheet
    Dim lastRow As Long, tempLastRow As Long
    
    Set ws1 = ThisWorkbook.Sheets("你的工作表名") '替换为实际表名
    lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    
    '创建临时工作表
    Set tempWs = ThisWorkbook.Sheets.Add
    tempWs.Name = "TempCopy"
    
    '复制筛选数据到临时表
    With ws1.Range("A1:Q" & lastRow)
        .AutoFilter Field:=6, Criteria1:="Movies"
        .Offset(1).SpecialCells(xlCellTypeVisible).Copy tempWs.Range("A1")
        .AutoFilter '关闭筛选
    End With
    
    '将临时表数据转贴回原表末尾
    tempLastRow = tempWs.Cells(tempWs.Rows.Count, "A").End(xlUp).Row
    tempWs.Range("A1:Q" & tempLastRow).Copy ws1.Range("A" & lastRow + 1)
    
    '清理临时表
    Application.DisplayAlerts = False
    tempWs.Delete
    Application.DisplayAlerts = True
End Sub

方法2：逐行复制避免区域重叠

先关闭筛选，再逐个复制可见行，适合数据量不大的场景：

Sub CopyVisibleRowsOneByOne()
    Dim ws1 As Worksheet
    Dim lastRow As Long, destRow As Long
    Dim visibleRng As Range, cell As Range
    
    Set ws1 = ThisWorkbook.Sheets("你的工作表名")
    lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    destRow = lastRow + 1
    
    '筛选并获取可见行区域
    With ws1.Range("A1:Q" & lastRow)
        .AutoFilter Field:=6, Criteria1:="Movies"
        Set visibleRng = .Offset(1).SpecialCells(xlCellTypeVisible)
        .AutoFilter '先关闭筛选
    End With
    
    '逐行复制到目标位置
    For Each cell In visibleRng.Columns(1).Cells
        cell.EntireRow.Copy ws1.Rows(destRow)
        destRow = destRow + 1
    Next cell
End Sub

注意事项 #

• 替换代码中的"你的工作表名"为实际工作表名称，或使用ActiveSheet指代当前激活表。
• 如果数据量较大，方法1的效率更高；方法2更直观，适合小数据量场景。

内容的提问来源于stack exchange，提问作者Natalia Fontiveros