VBA在行中查找文本1.如果大於零，則在下面的行中複製並粘貼

Question

我有一個代碼，用於搜索第1行中的文本字符串。沒有問題。

問題

當文本中找到我需要的宏搜索列的值大於零，如果找到複製整個行並粘貼到表2。所以我沒有成功。

請參見下面的代碼：

Private Sub btnUpdateEntry_Click() 

    Dim StringToFind As String 
Dim i As Range 
    StringToFind = Application.InputBox("Enter string to find", "Find string") 

    Worksheets("Skills Matrix").Activate 
    ActiveSheet.Rows(1).Select 

     Set cell = Selection.Find(What:=StringToFind, After:=ActiveCell, _ 
     LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _ 
     SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 


    For Each i In cell 
     If i.Value > 0 Then 
      i.Select 
      ActiveCell.Range("1:1").EntireRow.Select 
      Selection.Copy 
      Sheets("Sheet2").Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial 
     End If 
    Next i 

    If cell Is Nothing Then 
     Worksheets("Data").Activate 
     MsgBox "String not found" 
    End If 

End Sub 

謝謝。

Answer 1

試試這個，雖然我懷疑你需要搜索整個列嗎？你的循環只搜索一個單元格。如果搜索字符串可能在第一行中多次找到，則此代碼需要進行修改。

Private Sub btnUpdateEntry_Click() 

Dim StringToFind As String 
Dim i As Range 
Dim cell As Range 

StringToFind = Application.InputBox("Enter string to find", "Find string") 

With Worksheets("Skills Matrix") 
    Set cell = .Rows(1).Find(What:=StringToFind, LookAt:=xlWhole, _ 
          MatchCase:=False, SearchFormat:=False) 

    If Not cell Is Nothing Then 
     For Each i In .Range(cell.Offset(1), .Cells(.Rows.Count, cell.Column).End(xlUp)) 
      If IsNumeric(i.Value) Then 
       If i.Value > 0 Then 
        i.EntireRow.Copy 
        Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial 
       End If 
      End If 
     Next i 
    Else 
     Worksheets("Data").Activate 
     MsgBox "String not found" 
    End If 
End With 

End Sub