Vba回路范围特定范围

Question

我正在设计一个宏，在运行时它会在C列中查找值“2”，并将该行从单元格A-C复制到sheet2中。我工作的代码不起作用。请你帮帮我。

Sub LoopRange()

  Dim rCell As Range
  Dim rRng As Range

  Set rRng = Sheet1.Range("C1:C20")

  For Each rCell In rRng.Cells

    If rCell.Value = "2" Then
    Range(Cells(1, 1), Cells(3, 3)).Copy Sheets("Sheet2").Cells(1, 1)
    End If

  Next rCell

End Sub

Answer 1

您当前的代码每次都会将完全相同的单元格复制到完全相同的位置。试试这个：

Sub test()
  Dim rCell As Range
  Dim rRng As Range
  Dim cnt As Long
  cnt = 1

  Set rRng = Sheet1.Range("C1:C20")

  For Each rCell In rRng.Cells
    If rCell.Value = "2" Then
        Range(Cells(rCell.Row, 1), Cells(rCell.Row, 3)).Copy Sheets("Sheet2").Cells(cnt, 1)
        cnt = cnt + 1
    End If
  Next rCell
End Sub

表1测试数据：

表2结果：