Добавить данные к указанным c ячейкам в столбце

Question

Код ниже копирует из одного файла в другой. Я только хочу ДОБАВИТЬ слово «AVA» в ячейки в столбце H, но только до последнего ряда. Таким образом, в основном макро-фильтры для «PENDING» и у меня есть 14 строк ожидающих данных, тогда все 14 ячеек столбца H должны отображать «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

Answer 1

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