VBA在第1行中查找文本。如果大于零，则复制并粘贴到行下方

Question

i have a code which searches for a text string in row 1. The seraching has no issues .

Problem

When the text is found i need the macro to search the column for values greater that zero and if found to copy the whole row and paste into sheet 2. So i have had no success.

Please see code below:

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

Thank you.

Answer 1

Try this, although I doubt that you need to search the entire column? Your loop was only searching one cell. This code would need amending if the search string could be found more than once in the first row.

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

Answer 2

You need to write explicit to search ByRows

Set cell = .Rows(1).Find(What:=StringToFind, LookAt:=xlWhole, SearchOrder:=xlByRows, 
                             MatchCase:=False, SearchFormat:=False)