Excel 向列中的特定单元格添加数据

下面的代码从一个文件复制到另一个文件。 我只想将单词“AVA”添加到H列的单元格中，但只能添加到最后一行。 基本上，宏过滤器在“PENDING”上，我有14行挂起的数据，那么H列的所有14个单元格都应该显示“AVA”

有什么建议吗

Sub DS()

    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet

    Dim sourceWorkbookPath As String
    Dim targetWorkbookPath As String
    Dim lastRow As Long
    Dim i As Long


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

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

    ' definr worksheet's names for each workbook
    Set sourceSheet = sourceWorkbook.Worksheets("S TO S")
    Set targetSheet = targetWorkbook.Worksheets("Sheet1")

    Application.ScreenUpdating = False

    With sourceSheet

        ' Get last row
        lastRow = .Range("J" & .Rows.Count).End(xlUp).Row

        For i = 1 To lastRow
        .Range("H" & i).Value = "AVA" & .Range("H" & i).Value
    Next i

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

        .Range("J2:J" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
                                     Destination:=targetSheet.Range("A1")
        .Range("C2:C" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
                                     Destination:=targetSheet.Range("B1")
        .Range("D2:D" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
                                     Destination:=targetSheet.Range("E1")
        .Range("H2:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
                                     Destination:=targetSheet.Range("F1")
    End With


    With targetSheet
    For i = 1 To lastRow
        .Range("H" & i).Value = "AVA"
    Next i
End With

Application.ScreenUpdating = True
End Sub

---

如果你在尝试我的答案，我只是重新思考并更新了它，使之更干净。嗨@RicardoDiazHi@Mech谢谢你的帮助！我把它添加到我的代码中，我的excel挂断了。我只想在目标列H中输入“AVA”，直到包含data.NP的行为止。试试这个版本：）我已经添加了application.screenUpdate来帮助解决挂起问题。Hi@Mech It仍然挂起。你知道为什么吗？不是早些时候发生的。让我编辑我的代码，这样你就可以看到整个代码。谢谢你的完整代码。看起来你留下了原来的附加内容，导致了原来的挂断。如果这对您不起作用，您能告诉我运行宏时lastRow的产量吗？您可以debug.print、msgbox或使用F8一步一步地检查代码，并将鼠标悬停在变量名称上以获取值。Hi@Mech我尝试了debug和F8两种方法，但只要代码达到，它就会开始运行。我删除了所有内容并恢复了我的原始代码，它可以正常工作。只要输出相同，我愿意删除“With”代码。谢谢你不断的帮助！

Sub DS()

    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet

    Dim sourceWorkbookPath As String
    Dim targetWorkbookPath As String
    Dim lastRow As Long
    Dim i As Long

    Application.ScreenUpdating = False

    ' Define workbooks paths
    sourceWorkbookPath = "H:\Roy\Transfers Project\ Transfers 2020 - Roy.xlsm"
    targetWorkbookPath = "H:\Roy\ 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
    Set sourceSheet = sourceWorkbook.Worksheets("S TO S")
    Set targetSheet = targetWorkbook.Worksheets("Sheet1")

    With sourceSheet
        ' Get last row
        lastRow = .Range("J" & .Rows.Count).End(xlUp).Row

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

        .Range("J2:J" & lastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=targetSheet.Range("A1")
        .Range("C2:C" & lastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=targetSheet.Range("B1")
        .Range("D2:D" & lastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=targetSheet.Range("E1")
        .Range("H2:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy Destination:=targetSheet.Range("F1")
    End With


    With targetSheet
        For i = 1 To lastRow
            .Range("H" & i).Value = "AVA"
        Next i
    End With

    Application.ScreenUpdating = True
End Sub