根據單元格值復制行

Question

我正在嘗試在特定列中搜索“是”值，並將整行數據（如果存在）復制到新工作表中。

到目前為止，我復制並粘貼了一行不包含“是”的行。 這導致粘貼了四行相同的數據，而不是我需要的四行。

Dim rng As Range, cell As Range

Dim sht As Worksheet
Set sht = Worksheets("Output")

With sht
    lastRow = .Range("R" & .Rows.Count).End(xlUp).Row
End With

If lastRow < 2 Then lastRow = 2

Set rng = sht.Range("R2:R" & lastRow)

For Each cell In rng
    If cell.Value = "Yes" Then
        ActiveCell.EntireRow.Copy
        Worksheets("Callouts").Activate
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveCell.PasteSpecial Paste:=xlPasteValues
    End If
Next
End Sub

Answer 1

首先，您要遍歷每一行，然后遍歷行中的每個單元格以找到“是”。 然后你想將該行復制到新工作表。 考慮：

Dim rng As Range, cell As Range
Dim targetLastRow as Range

Dim sht As Worksheet
Set sht = Worksheets("Output")    

'capture last row in source
sourceLastRow = sht.Range("R" & Rows.Count).End(xlUp).Row   
If sourceLastRow < 2 Then sourceLastRow = 2

'set source rng
Set rng = sht.Range("R2:R" & lastRow)


'Capture last row in target sheet
targetLastRow = Sheets("Callouts").Range("A" & Rows.Count).End(xlUp).Row

'iterate through each row in source range
For each row in rng.rows 
    'iterate through each cell in row
    For Each cell In row
        If cell.Value = "Yes" Then
            cell.EntireRow.Copy 
            Sheets("Callouts").Cells(targetLastRow, 1).PasteSpecial Paste:=xlPasteValues
            'increment target to next row 
            targetLastRow = targetLastRow + 1
        End If
    Next
Next