VBA -多次复制已过滤的行

Sub CopyFilteredRows()
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    Dim srcRange As Range
    Dim destRange As Range
    Dim filteredRange As Range
    Dim filteredRow As Range
    
    ' 设置源工作表和目标工作表
    Set srcSheet = ThisWorkbook.Worksheets("Sheet1")
    Set destSheet = ThisWorkbook.Worksheets("Sheet2")
    
    ' 获取源数据范围
    Set srcRange = srcSheet.Range("A1").CurrentRegion
    
    ' 过滤数据
    srcRange.AutoFilter Field:=1, Criteria1:="条件"
    
    ' 获取过滤后的行范围
    Set filteredRange = srcRange.SpecialCells(xlCellTypeVisible).EntireRow
    
    ' 复制过滤后的行到目标工作表
    For Each filteredRow In filteredRange.Rows
        ' 在目标工作表中找到下一个空行
        Set destRange = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
        
        ' 复制行
        filteredRow.Copy destRange
    Next filteredRow
    
    ' 清除过滤
    srcSheet.AutoFilterMode = False
    
    ' 提示复制完成
    MsgBox "已复制过滤后的行到目标工作表。"
End Sub