problem code was work and recently doesn't work

Sub TransferData()

Dim a, b, i&, Dic As Object
Set Dic = CreateObject("scripting.dictionary")

a = Sheets("Sheet1").[B7].CurrentRegion
ReDim b(1 To UBound(a), 1 To 10000)

For x = 2 To UBound(a)
    If Not Dic.exists(a(x, 2)) Then
        i = i + 1
        Dic.Add a(x, 2), i
        b(1, i) = a(x, 2)
    End If
Next

For x = 2 To UBound(a)
    i = Dic(a(x, 2))
    For y = 2 To UBound(b)
        If IsEmpty(b(y, i)) Then
            b(y, i) = a(x, 3)
            Exit For
        End If
    Next
Next

Sheets("Sheet2").[C8].Resize(UBound(b), UBound(b, 2)) = b