Wsrtjtyk

Good day to everyone,

I have been trying to find an answer here that would fit my problem but I have been unsuccessful. I am using FIND to search column F for cell with #N/A value and copy adjacent cells to another "Sheet2" at the end of the column A. I have made the following code that works but my problem is I want to make it to loop to find the next cell with #N/A value till find all.

Sub Find()

    Dim SerchRange As Range

    Dim FindCell As Range

    Set SerchRange = Range("F:F")

    Set FindCell = SerchRange.FIND(What:="#N/A", _

      LookIn:=xlValues, _

      LookAt:=xlWhole, _

      SearchOrder:=xlByRows, _

      SearchDirection:=xlNext, _

      MatchCase:=False)



    If FindCell Is Nothing Then

        MsgBox "Nothing was found all clear"    

    Else

        FindCell.Select

        ActiveCell.Offset(0, -3).Resize(, 3).Select

        Selection.Copy

        Sheets("Sheet2").Select

        Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select

        ActiveSheet.Paste

    End If

End Sub

Try this and let me know if it works:

Option Explicit

Sub Find()

Application.ScreenUpdating = False

Dim SearchRange As Range

Dim FindCell As Range

Dim Check As Boolean

Dim LastRow As Long

Dim ws As Worksheet

Dim ws2 As Worksheet

Dim FindCounter As Long



Set ws = ThisWorkbook.Worksheets("Sheet1") ' <--- Insert the name of your worksheet here

Set ws2 = ThisWorkbook.Worksheets("Sheet2")

LastRow = ws.Cells(Rows.Count, "F").End(xlUp).Row ' <--- Finds the last used row

Set SearchRange = Range("F1:F" & LastRow)

FindCounter = 0



For Each FindCell In SearchRange

    If FindCell.Value = "#N/A" Then

        FindCounter = FindCounter + 1

        FindCell.Offset(0, -3).Resize(, 3).Copy

        ws2.Range("A" & ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteValues

    End If

Next



MsgBox "Succes!" & vbNewLine & vbNewLine & "This many cells were found: " & FindCounter

Application.ScreenUpdating = True

End Sub