XL 2013 Ventilation des montants sur un mois précis

Sub Import_Budget_Moins1()
Dim fichier$, tablo, d As Object, i&, e, F As Worksheet, a, b()
fichier = ThisWorkbook.Path & "\Budget -1.xlsx" 'à adapter
Application.ScreenUpdating = False
On Error Resume Next
With Workbooks.Open(fichier)
    tablo = .Sheets(1).[A1].CurrentRegion 'matrice, plus rapide
    .Close False
End With
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(tablo): d(tablo(i, 4)) = "": Next
For Each e In d.keys
    Set F = Nothing: Set F = Sheets(e)
    a = F.Range("A3", F.Range("A" & F.Rows.Count).End(xlUp)(3)) 'matrice, plus rapide, au moins 2 éléments
    ReDim b(1 To UBound(a) - 2, 1 To 12) 'tableau pour les 12 mois
    d.RemoveAll
    For i = 1 To UBound(b): d(a(i, 1)) = i: Next 'mémorise le LIBELLE et la ligne
    For i = 2 To UBound(tablo)
        If tablo(i, 4) = e Then If d.exists(tablo(i, 3)) Then _
            b(d(tablo(i, 3)), tablo(i, 6)) = b(d(tablo(i, 3)), tablo(i, 6)) + tablo(i, 7)
    Next i
    '---restitution---
    With F.[N3] 'à adapter éventuellement
        .Resize(UBound(b), 12) = b
    End With
Next e
End Sub