查找字符串，然後複製並粘貼到另一個工作表中以查找特定列

Question

我對VBA相對較新，並且正在慢慢學習。

我有一個非常基本的宏，將查找單詞PASS在C列在我的第一個工作表，然後將整個行復制到工作表輔助，也稱爲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 

Answer 1

試試這個

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 

Answer 2

我已經適應你的代碼，並改變了以下內容：

• 定義了一些Range變量來簡化代碼
• 如果變化是C欄然後Target單元給我們行
• 通過獲取最後一行上找到PASS片目標行+ 1
• 限定於通過使用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