fusion de tableau avec comparaison d'une cellule

Option Explicit

Sub alignement()
Dim a, i As Long, j As Long, w(), txt As String, x, y
    a = Sheets("LANCELOT").Range("a1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            txt = CStr(a(i, 2))
            ReDim w(1 To 18)
            For j = 1 To UBound(a, 2)
                w(j + 12) = a(i, j)
            Next
            .Item(txt) = w
        Next
        a = Sheets("SOLIS").Range("a1").CurrentRegion.Value
        For i = 1 To UBound(a, 1)
            txt = CStr(a(i, 2))
            If .exists(txt) Then
                w = .Item(txt)
                For j = 1 To UBound(a, 2)
                    w(j) = a(i, j)
                Next
            Else
                ReDim w(1 To 18)
                For j = 1 To UBound(a, 2)
                    w(j) = a(i, j)
                Next
            End If
            .Item(txt) = w
        Next
        y = .items: x = .Count
    End With
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Resultat").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Sheets.Add.Name = "Resultat"
    With Sheets("Resultat").Cells(1)
        .Resize(x, 18).FormulaLocal = _
        Application.Transpose(Application.Transpose(y))
        With .CurrentRegion
            .Font.Name = "calibri"
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            With .Rows(1)
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 40
                .Font.Bold = True
                .BorderAround Weight:=xlThin
            End With
            .Columns("e").NumberFormat = "mmm-yy"
            .Columns("p:r").NumberFormat = "# ##0.00"
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub