Try along the lines of: 
Sub blah()
Set Destn = Sheets("Table3").Range("B6")
For Each cll In Sheets("Table1").Range("B6:B15")
  Destn.Value = cll.Value
  PokemonNames = Split(cll.Offset(, 2).Value, ",")
  ofset = 1
  For Each PokemonName In PokemonNames
    RowNo = Application.Match(Application.Trim(PokemonName), Sheets("Table2").Columns(1), 0)
    If Not IsError(RowNo) Then
      Sheets("Table2").Cells(RowNo, "B").Copy Destn.Offset(, ofset)
      ofset = ofset + 1
    End If
  Next PokemonName
  Set Destn = Destn.Offset(1)
Next cll
End Sub
No clearing of destination sheet beforehand, no checks. It places images in adjacent cells (not into the same cell), so ensure columns are wide enough to allow you to see whole image.