Scripting Dictionary to update values

Hi

I have a script where I am referencing data from one sheet (A.aa) to another (B.bb) based on if the value is found (Column A), however, I am finding the data to the right of my sheet is being overwritten based on the number of columns that are being skipped. Any help would be greatly appreciated.

Sub Update_ProjectInput()

Dim Key As String
Dim a As Workbook
Dim aa As Worksheet
Dim b As Workbook
Dim bb As Worksheet
Dim r As Long
On Error GoTo CriticalErrors

Application.ScreenUpdating = False
Set a = ThisWorkbook
Set aa = a.Sheets("A.AA")
Set b = ThisWorkbook
Set bb = b.Sheets("B.bb (Current Result)")
    
With CreateObject("Scripting.Dictionary")
    For r = 2 To aa.Range("A" & Rows.Count).End(xlUp).Row
        Key = aa.Cells(r, 1)
        .Item(Key) = r
    Next r
    For r = 3 To bb.Range("A" & Rows.Count).End(xlUp).Row
        Key = bb.Cells(r, 1)
        If .exists(Key) Then bb.Cells(r, 6).Resize(1, 10).Value = aa.Cells(.Item(Key), 2).Resize(1, 5).Value
    Next r
End With

MsgBox "Completed", vbInformation, "Script Completed!"
Application.ScreenUpdating = True
Exit Sub

CriticalErrors:
MsgBox "An error has occured with the Update_ProjectInput Module, Please contact ", vbCritical, "Crikey!"
Application.ScreenUpdating = True
End

End Sub