查找字符串，然后复制并粘贴到特定列的另一个工作表中答案

【问题标题】：Find string then copy and paste in another worksheet for specific columns查找字符串，然后复制并粘贴到特定列的另一个工作表中
【发布时间】：2016-11-04 22:55:35
【问题描述】：

我对 VBA 比较陌生，正在慢慢学习。

我有一个非常基本的宏，它将在我的第一个工作表上的C 列中查找单词PASS，然后将整行复制到也称为PASS 的辅助工作表中。

我试图仅从列A:E 复制和粘贴该行中的数据。以下是我当前的代码。我试过添加.range("A:E")，但它什么也没做。

任何有关如何仅复制该特定行的 A-E 列中的信息的帮助将不胜感激。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range

  If Intersect(Target, Me.Range("C:C")) Is Nothing Then Exit Sub
  For Each C In Intersect(Target, Me.Range("C:C")).Cells
    If C.Text = "PASS" Then
      C.EntireRow.Copy Worksheets("PASS").Cells(Rows.Count, "C").End(xlUp).Offset(1).EntireRow
    End If  
  Next
End Sub

【问题讨论】：

引用范围时需要指定行号和列。 range("A:E") 仅指定列。它需要类似于 `range("a54:e54")。
@Scott Marcus - 尽管效率不高，但您可以像这样引用整个列。

标签： excel macros vba

【解决方案1】：

我已经修改了您的代码并更改了以下内容：

定义了一些 Range 变量以使代码更简单
如果更改发生在 C 列中，则 Target 单元格为我们提供行
通过获取最后一行 + 1 在 PASS 工作表上查找目标行
使用Target的行定义要复制的数据，但A到E的列
获取目标范围的第一个单元格，然后进行复制

代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngSource As Range
    Dim lngTargetRow As Long
    Dim rngTarget As Range

    'was change in column C ?
    If Intersect(Target, Me.Range("C:C")) Is Nothing Then
        Exit Sub
    End If

    'change was in column C - was PASS entered
    If Target.Text = "PASS" Then
        'get row to copy to on PASS sheet
        lngTargetRow = Worksheets("PASS").Cells(Rows.Count, "C").End(xlUp).Row + 1
        'get source range
        Set rngSource = Me.Range("A" & Target.Row & ":E" & Target.Row)
        'set target range
        Set rngTarget = Worksheets("PASS").Cells(lngTargetRow, 1)
        'do the copy
        rngSource.Copy Destination:=rngTarget
    End If

End Sub

【讨论】：

感谢您的帮助。这也有效！我将使用 SJR 的第一个答案，因为作为新手，它更有意义，我能够按照代码进行并理解。这只是我的宏的一小部分，所以我希望它尽可能基本。

【解决方案2】：

试试这个

Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range

  If Intersect(Target, Me.Range("C:C")) Is Nothing Then Exit Sub
  For Each C In Intersect(Target, Me.Range("C:C")).Cells
    If C.Text = "PASS" Then
      cells(C.Row,1).resize(,5).Copy Worksheets("PASS").Cells(Rows.Count, "C").End(xlUp).Offset(1).EntireRow
    End If  
  Next
End Sub

【讨论】：