Question

以下代码从一个文件复制到另一个文件。我只想将单词“ AVA”添加到H列中的单元格中，但只保留到最后一行。因此，基本上，“ PENDING”上的宏过滤器有14行Pending数据，那么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

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

将数据添加到列中的特定单元格

1 个答案: