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.