Excel VBA programming to copy specific rows from sheet1 to sheet2 specific cell

Question

I want to write one vba code which will search data from a specific column of sheet1 and copy those rows and paste those to sheet2. I have written the code but found one problem there. here is the code below.

    Sheets("Sheet1").Select
    Range("D1").Select
    Dim mycode As Worksheet
    Set mycode = ThisWorkbook.Worksheets("Sheet2")
    Dim i As Long
    For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
        If Cells(i, 4).Value = "high" Then
            Range(Cells(i, 1), Cells(i, 8)).Copy Destination:=mycode.Range("A" & mycode.Cells(Rows.Count, "A").End(xlUp).Row + 1)
            ElseIf Cells(i, 4).Value <> "high" Then
            Sheets("Sheet2").Select
            Range("A2").Value = "No Crtical Logs Found"
            End If
        Next i
    End Sub

From sheet1 column D(number4) I am searching data matching "high" and copy paste those rows to sheet2. And if any of the "high" is not there in column D then "No action required" will be written in cell A2 on sheet2. But the problem is when "high" value is not there it is working fine but when "high" value is there in D column sheet1 then all time "no action required" value is coming on cell A2 on sheet2. Please help me to rectify this.

No Crtical Logs Found   4/11/2016   Critical    high        192.168.1.1 This is the sample excel sheet  Action Required

Regards, Pinaki

Gary's Student Gary's Student · Accepted Answer · 2016-05-11T20:45:37

You are moving off Sheet1 too soon:

Sub fhskdfh()
    Sheets("Sheet1").Select
    Range("D1").Select
    Dim mycode As Worksheet
    Set mycode = ThisWorkbook.Worksheets("Sheet2")
    Dim i As Long
    For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
        MsgBox i & vbCrLf & Cells(i, 4).Value
        If Cells(i, 4).Value = "high" Then
            Range(Cells(i, 1), Cells(i, 8)).Copy Destination:=mycode.Range("A" & mycode.Cells(Rows.Count, "A").End(xlUp).Row + 1)
        End If
    Next i
End Sub

Excel VBA programming to copy specific rows from sheet1 to sheet2 specific cell

2 Answers