macro failing

Hi
I Aam running the following code to transfer info from one workshet to another but it is failing

I am getting

run-time error '1004':
Application- defined or object -defined error

It work ok the first time but fails the second-third etc

Any help i would be greatful

Sub try33511()
Dim a As New Collection, x, y, i As Long, n As Long, rcount As Long, lrowsupp As Long
If Sheets("Pivots").[AO1] = "" Then Exit Sub
Application.ScreenUpdating = 0
With Sheets("Pivots"): y = .Range(.[AO1], .Cells(Rows.Count, "ao").End(xlUp).Offset(, 1)): End With: rcount = UBound(y)
With Sheets("reason 33511"): x = .Range(.[a2], .Cells(Rows.Count, "a").End(xlUp).Offset(rcount, 1)): lrowsupp = UBound(x) - UBound(y)
On Error Resume Next
For i = 1 To UBound(x)
   If x(i, 1) <> "" Then a.Add i, CStr(x(i, 1))
Next
Err.Clear
For i = 1 To UBound(y)
    a.Add i, CStr(y(i, 1))
    If Err.Number = 0 Then
        n = n + 1
        x(lrowsupp + n, 1) = y(i, 1)
        x(lrowsupp + n, 2) = y(i, 2)
    Else
        x(a.Item(CStr(y(i, 1))), 2) = y(i, 2)
        Err.Clear
    End If
Next
.[a2].Resize(UBound(x), 2) = x: End With
End Sub