Evaluate Match 3 sheets continue when error (probably Loop?)

Hello,

In the attached Example I'm trying to get excel to fill in Sheet_B and Sheet_C with data filled in by a user in Sheet_A.

The problem is that the code stops as soon as it cannot find a stock number in Sheet_B that is listed in Sheet_C. Also, it must be possible to make mistakes that are shown after the macro filled in the stock numbers that were found in Sheet B and C. In short:

1. Pressing the button in sheet A fills in Sheet B and C.
2. When it cannot find a (new) stock number it should bring up a msg box with the stock numbers that could not be found.

This is the code I have so far:

Sub The_Button()
   '
   ' The_Button Macro
   '
   Dim sh1 As Worksheet
   Dim sh2 As Worksheet
   Dim destRow, destCol
   
   With ThisWorkbook
      Set sh1 = .Sheets(1)
      Set sh2 = .Sheets(2)
      
   End With
   
   destRow = Evaluate("match(" & sh1.Name & "!b4 & " & sh1.Name _
      & "!b5, " & sh2.Name & "!a1:a500 & " & sh2.Name & "!b1:b200, 0)")
   If IsError(destRow) Then
      MsgBox ("Item/order: " & sh1.Range("B4") & "/" & sh1.Range("B5") _
         & " not found in Sheet: " & sh2.Name)
      Exit Sub
   End If
   
   lastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
   For r = 8 To lastRow
      destCol = Evaluate("match(" & sh1.Name & "!a" & r & "," & sh2.Name & "!3:3,0)")
      If IsError(destCol) Then
         MsgBox ("Stocknumber " & sh1.Cells(r, 1) & " not found in Sheet: " _
            & sh2.Name)
         Exit Sub
      End If
   
      sh2.Cells(destRow, destCol) = sh1.Cells(r, 2)
   Next
   
'Copied from above with

   Dim sh3 As Worksheet
  
   With ThisWorkbook
      Set sh3 = .Sheets(3)
      
   End With
   
   destRow = Evaluate("match(" & sh1.Name & "!b4 & " & sh1.Name _
      & "!b5, " & sh3.Name & "!a1:a500 & " & sh3.Name & "!b1:b200, 0)")
   If IsError(destRow) Then
      MsgBox ("Item/order: " & sh1.Range("B4") & "/" & sh1.Range("B5") _
         & " not found in Sheet: " & sh3.Name)
      Exit Sub
   End If
   
   lastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
   For r = 8 To lastRow
      destCol = Evaluate("match(" & sh1.Name & "!a" & r & "," & sh3.Name & "!3:3,0)")
      If IsError(destCol) Then
         MsgBox ("Stocknumber " & sh1.Cells(r, 1) & " not found in Sheet: " _
            & sh3.Name)
         Exit Sub
      End If
   
      sh3.Cells(destRow, destCol) = sh1.Cells(r, 2)
   Next
   
End Sub

Thanks in advance,

Psj

Try with this

Sub test()
Dim mysheet As Worksheet, myval, myval2, lr As Long, lr2 As Long, myrow, mycol, myorder, myitem, tel As Byte, mystring As String
myorder = Range("B4")
myitem = Range("B5")
lr = Range("A" & Rows.Count).End(xlUp).Row
For j = 8 To lr
    tel = 0
    myval = Sheets("Sheet_A").Range("A" & j)
    myval2 = Sheets("Sheet_A").Range("B" & j)
    For x = 2 To Sheets.Count
        With Sheets(x)
            If Application.CountIf(.Range("C3", "XFD3"), myval) > 0 Then
                tel = 1
                Set mysheet = Sheets(x)
                With Sheets(mysheet.Name)
                    lr2 = .Range("A" & Rows.Count).End(xlUp).Row
                    For i = 4 To lr2
                        If .Range("A" & i) = myorder And .Range("B" & i) = myitem Then
                            myrow = i
                            Exit For
                        End If
                    Next
                    mycol = Application.Match(myval, .Range("A3", "XFD3"), 0)
                    .Cells(myrow, mycol) = myval2
                End With
            End If
        End With
    Next x
    If tel = 0 Then mystring = mystring & Chr(13) & myval
Next j
MsgBox "Stock numbers not found" & Chr(13) & mystring
End Sub

Kind regards
Leo