修改VBA代码实现筛选数据追加至目标工作簿末尾

先修正原代码的拼写错误，再添加逻辑实现数据追加而非覆盖原有内容：

Sub DS()
    Dim sourceWorkbook As Workbook ' 修正原拼写错误：sourceWorkook -> sourceWorkbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet

    Dim sourceWorkbookPath As String
    Dim targetWorkbookPath As String
    Dim sourceLastRow As Long
    Dim targetLastRow As Long ' 新增变量：存储目标工作表的最后一行

    ' Define workbooks paths
    sourceWorkbookPath = "H:\L\Roy\RT\Transfers\Transfers 2020 - Roy.xlsm"
    targetWorkbookPath = "H:\L\Roy\H and E\2020\SAP - ZPSD02_template2.xlsx"

    ' Set a reference to the target Workbook and sheets
    Set sourceWorkbook = Workbooks.Open(sourceWorkbookPath)
    Set targetWorkbook = Workbooks.Open(targetWorkbookPath)

    ' define worksheet's names for each workbook ' 修正原拼写错误：definr -> define
    Set sourceSheet = sourceWorkbook.Worksheets("ST TO ST")
    Set targetSheet = targetWorkbook.Worksheets("Sheet1")

    With sourceSheet
        ' Get last row of source sheet
        sourceLastRow = .Range("J" & .Rows.Count).End(xlUp).Row

        ' Apply filters
        .Range("A1:O1").AutoFilter Field:=12, Criteria1:="PENDING"
        .Range("A1:O1").AutoFilter Field:=10, Criteria1:="U3R", Operator:=xlOr, Criteria2:="U2R"
    End With

    ' 获取目标工作表A列的最后一行（以A列为基准确定追加起始位置）
    targetLastRow = targetSheet.Range("A" & targetSheet.Rows.Count).End(xlUp).Row

    ' 复制筛选后的数据到目标工作表的下一行
    sourceSheet.Range("J2:J" & sourceLastRow).SpecialCells(xlCellTypeVisible).Copy _
                                 Destination:=targetSheet.Range("A" & targetLastRow + 1)
    sourceSheet.Range("C2:C" & sourceLastRow).SpecialCells(xlCellTypeVisible).Copy _
                                 Destination:=targetSheet.Range("B" & targetLastRow + 1)
    sourceSheet.Range("D2:D" & sourceLastRow).SpecialCells(xlCellTypeVisible).Copy _
                                 Destination:=targetSheet.Range("E" & targetLastRow + 1)
    sourceSheet.Range("H2:H" & sourceLastRow).SpecialCells(xlCellTypeVisible).Copy _
                                 Destination:=targetSheet.Range("F" & targetLastRow + 1)

    ' 可选：关闭自动筛选（恢复源工作表状态）
    sourceSheet.AutoFilterMode = False

    ' 可选：保存目标工作簿的变更
    ' targetWorkbook.Save
End Sub

关键修改说明 #

• 新增targetLastRow变量，通过目标工作表A列的最后行位置，计算出数据追加的起始行（targetLastRow + 1）
• 修正原代码两处拼写错误：sourceWorkook改为sourceWorkbook，definr改为define
• 将复制目标从固定的A1/B1等静态位置，改为动态的行号位置，实现追加而非覆盖
• 补充了可选的自动筛选关闭、目标工作簿保存代码，可按需启用

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