Delete Rows in Sheet 1 if values exist other that ones in Column in Sheet 2 | Run-time error '9'

Im getting the 'Subscript out of range error' in this line:

a = wb2.Sheets("Key").Range("A2", Sheets("Key").Range("A" & Rows.Count).End(xlUp)).Value

Would really really appreciate help :)

The SUB:

Sub Del_Rws()


 Dim d As Object
  Dim a As Variant, b As Variant, itm As Variant
  Dim nc As Long, i As Long, k As Long




Set d = CreateObject("Scripting.Dictionary")
  a = Sheets("Sheet2").Range("A2", Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)).Value
  For Each itm In a
    d(itm) = 1
  Next itm
  With Sheets("Sheet1")
    a = .Range("H2", .Range("H" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If Not d.exists(a(i, 1)) Then
        k = k + 1
        b(i, 1) = 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
      With .Range("A2").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

Code credit: Peter_SSs