如果单元格包含这个或那个粘贴到另一张纸上

Question

I have 2 sheets in my workbook SheetJS and Sheet1 . I have this code that partially matches cells in each row that contain the phrase "ABC" in SheetJS and copies them to Column D in Sheet1 . It them partially matches cells that contain the phrase "123" in SheetJS and copies then to Column G in Sheet1 .

How can I change the code to partially match cells in each row in Sheet1 containing either "ABC" or "132" and pastes the values to Column D in Sheet1 ?

I will write a similar macro to copy values into Column G in Sheet1

Sub Extract_Data_or()

    For Each cell In Sheets("SheetJS").Range("A1:ZZ200")

        matchrow = cell.Row

        If cell.Value Like "*ABC*" Then 

            Sheets("Sheet1").Range("D" & matchrow).Value = cell.Value

        ElseIf cell.Value Like "*123*" Then

            Sheets("Sheet1").Range("G" & matchrow).Value = cell.Value

        End If

    Next

End Sub

Any tips will help thank you!

Answer 1

Use OR logic.

Sub Extract_Data_or()
    For Each cel In Sheets("SheetJS").Range("A1:ZZ200")
        matchrow = cel.Row

        If (cel.Value Like "*ABC*") Or (cel.Value Like "*123*") Then
            Sheets("Sheet1").Range("D" & matchrow).Value = cel.Value
        End If
    Next
End Sub

Answer 2

I asked for some clarifications, bun not receiving any answer I will start from the next assumptions:

Column D:D of "Sheet1" contains 200 rows filled with data.

Private Sub Extract_Data_or_Arr()
  Dim rngArr As Variant, dArr As Variant
  Dim sh As Worksheet, i As Long, j As Long
  Dim lngOcc As Long, lngChanges As Long, boolFound As Boolean

  Set sh = Sheets("TestOcc")
   rngArr = Sheets("SheetJS").Range("A1:ZZ200").Value
   dArr = sh.Range("D1:D200").Value

    For i = 1 To UBound(rngArr, 1)
        boolFound = False
        For j = 1 To UBound(rngArr, 2)
          If InStr(rngArr(i, j), "ABC") > 0 Or InStr(CStr(rngArr(i, j)), "123") > 0 Then
              If Not boolFound Then lngChanges = lngChanges + 1
              lngOcc = lngOcc + 1: boolFound = True
              dArr(i, 1) = rngArr(i, j)
          End If
       Next j
    Next i
    sh.Range("D1:D200").Value = dArr
    MsgBox lngOcc & " occurrences, vesus " & lngChanges & " changes made."
End Sub

Finally it returns the number of occurrences versus number of changes made.