Change to
Sub test()
    Dim ws As Worksheet, a, e, i As Long, ii As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each ws In Worksheets
            Select Case ws.Name
                Case "Final_before", "Final_after"
                Case Else
                    a = ws.Cells(1).CurrentRegion.Value
                    For i = 2 To UBound(a, 1)
                        If Not .exists(a(i, 1)) Then
                            Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
                            .Item(a(i, 1)).CompareMode = 1
                        End If
                        For ii = 2 To UBound(a, 2)
                            If Not dic.exists(a(1, ii)) Then dic(a(1, ii)) = Empty
                            .Item(a(i, 1))(a(1, ii)) = IIf(IsEmpty(.Item(a(i, 1))(a(1, ii))), _
                                a(i, ii), Application.Min(a(i, ii), .Item(a(i, 1))(a(1, ii))))
                        Next
                    Next
            End Select
        Next
        a = Sheets("final_before").Cells(1).CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If .exists(a(i, 1)) Then
                For ii = 2 To UBound(a, 2)
                    a(i, ii) = .Item(a(i, 1))(a(1, ii))
                Next
            End If
        Next
    End With
    Sheets("final_before").Cells(1).CurrentRegion.Value = a
End Sub