Summarize Columns, Based On Unique Value, Into 1 Sheet With Cell Addresses

I have the following code always throwing this error message: "subscript out of range". When i run the macro with worksheets that only have 10 rows each, it's running fine. I suspect some issues on the line: a = Range("a1"). CurrentRegion.Resize(, 3) - the debug always throws the error before entering the loop. This macro is supposed to find the lowest price among 3 spreadsheets by matching the "Code" column and sending the final result into a new spreadsheet. But since im trying to run the macro on spreadsheets holding over 6000 lines each, this error is appearing.

Sub kTest_v2()
Dim a, w(), i As Long, z, dic As Object
Dim MySheets, ws As Worksheet, MinPrice
MySheets = Array("Sheet1", "Sheet2", "Sheet3") 'change to suit
Set dic = CreateObject("scripting.dictionary")
dic.comparemode = vbTextCompare
For Each ws In Sheets(MySheets)
With ws
.Activate
'assume Col A Country, Col B Code and Col C Price
a = Range("a1").CurrentRegion.Resize(, 3)
End With
For i = 2 To UBound(a, 1) 'assume column heading. if not replace 2 with 1
If Not IsEmpty(a(i, 1)) Then
If Not dic.exists(a(i, 2)) Then
Redim w(1 To 4): w(1) = a(i, 1) 'Country
w(2) = a(i, 2) 'Code
w(3) = a(i, 3) 'Price
w(4) = Cells(i, 1).Address(external:=True) 'cell address
dic.Add a(i, 2), w
Else.............................