如何用VBA将Sheet1筛选后的数据追加到Output工作表已有数据后？

完整代码 #

Sub AppendFilteredData()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastSourceRow As Long
    Dim lastTargetRow As Long
    
    ' 定义源工作表和目标工作表
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    Set targetSheet = ThisWorkbook.Worksheets("Output")
    
    ' 获取Sheet1中筛选后数据的最后一行（可见区域）
    lastSourceRow = sourceSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    
    ' 获取Output表已有数据的最后一行（以A列为基准，可按需修改列）
    lastTargetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 复制筛选后的可见数据（假设数据从A1开始，覆盖所有列）
    sourceSheet.Range("A1:" & sourceSheet.Cells(lastSourceRow, sourceSheet.Columns.Count).Address).SpecialCells(xlCellTypeVisible).Copy
    
    ' 粘贴到Output表的空白起始行
    targetSheet.Cells(lastTargetRow, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    ' 清除剪贴板状态，避免弹窗提示
    Application.CutCopyMode = False
End Sub

关键细节说明 #

• 确定目标表最后一行：targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row 会从A列最底部向上查找第一个非空单元格，得到已有数据的最后一行，+1 用于定位到下一行空白位置。如果你的数据关键列不是A，直接替换成对应列标（如"B"、"C"）即可。
• 复制筛选数据：SpecialCells(xlCellTypeVisible) 确保只复制筛选后的可见行，不会包含隐藏的未筛选数据。
• 粘贴选项：代码中使用xlPasteValuesAndNumberFormats仅粘贴值和数字格式，若需保留公式、单元格格式等，可改为xlPasteAll或其他合适的粘贴枚举值。

内容的提问来源于stack exchange，提问作者Saurabh Jhalani