Вставка в один столбец на основе критериев в другом

Question

Я пытаюсь вставить ряд формул с одного листа на другой.В целевой таблице код ищет критерии в столбце A, а затем, если они выполнены, вставляется в столбец H. Он идет от последней использованной ячейки вверх.Я уверен, что это материал начального уровня, но если кто-то может помочь, это будет очень цениться.Код ниже

Sub Step8()

'Copies cells from worksheet called "Bi-Weekly"

    Worksheets("Bi-Weekly").Activate
    Range("H16:BK16").Copy


'Go to target worksheet called "Report"

    Worksheets("Report").Activate

    Dim lRow As Long


'find last row

    lRow = Cells(Rows.Count, 1).End(xlUp).Row

'Loop from the last row to the first (finishing at row 17)

    For i = lRow To 17 Step -1

'Where column A = "No", paste copied cells to column H (to BK) from original worksheet

    If ActiveSheet.Range("A" & i).Value = "No" Then
    ActiveSheet.Range("H" & i).Paste
    End If
Next i


End Sub

Answer 1

Копирование формул

Код

Sub Step8()

    Const cSource As String = "Bi-Weekly" ' Source Worksheet Name
    Const cRange  As String = "H16:BK16"  ' Source Range Address
    Const cTarget As String = "Report"    ' Target Worksheet Name
    Const cColCrit As Variant = 1         ' Target Criteria Column Letter/Number
    Const cColTgt As Variant = "H"        ' Target Column Letter/Number
    Const cfRow As Long = 17              ' Target First Row
    Const cCrit As String = "No"          ' Target Criteria

    Dim rng As Range  ' Source Range
    Dim lRow As Long  ' Target Last Row Number
    Dim i As Long     ' Target Worksheet Row Counter

    ' Create a reference to the Source Range (rng).
    Set rng = ThisWorkbook.Worksheets(cSource).Range(cRange)
    ' In Target Worksheet
    With ThisWorkbook.Worksheets(cTarget)
        ' Calculate Last Row Number (lRow)
        ' from Target Criteria Column (cColCrit).
        lRow = .Cells(.Rows.Count, cColCrit).End(xlUp).Row
        ' Loop through rows (cells) of Target Worksheet starting from First Row.
        For i = cfRow To lRow
            ' When the cell at the intersection of the current row (i)
            ' and the Target Criteria Column (cColCrit) contains
            ' the Target Criteria (cCrit).
            If .Cells(i, cColCrit).Value = cCrit Then
                ' Copy Source Range (rng) to the cell at the intersection
                ' of the current row (i) and Target Column (cColTgt).
                rng.Copy .Cells(i, cColTgt)
            End If
        Next
    End With

End Sub

Без констант Версия

Sub Step8NoConstants()

    Dim rng As Range  ' Source Range
    Dim lRow As Long  ' Target Last Row Number
    Dim i As Long     ' Target Worksheet Row Counter

    ' Create a reference to the Source Range (rng).
    Set rng = ThisWorkbook.Worksheets("Bi-Weekly").Range("H16:BK16")
    ' In Worksheet "Report".
    With ThisWorkbook.Worksheets("Report")
        ' Calculate Last Row Number (lRow) from column 1 ("A").
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        ' Loop through rows (cells) of worksheet "Report" starting from row 17.
        For i = 17 To lRow
            ' When the cell at the intersection of the current row (i)
            ' and column 1 ("A") contains "No".
            If .Cells(i, 1).Value = "No" Then
                ' Copy Source Range (rng) to the cell at the intersection
                ' of the current row (i) and column "H".
                rng.Copy .Cells(i, "H")
            End If
        Next
    End With

End Sub