Combiner deux tableaux

Sub CmbnTab()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim Plg As Range, PlgWS1 As Range, PlgWS2 As Range

    Set mondico = CreateObject("Scripting.Dictionary")

    Set WS1 = Sheets("feuil1")
    Set WS2 = Sheets("feuil2")
    Set WS3 = Sheets("feuil3")

    With WS1
        Set PlgWS1 = .Range(.[A2], .[A65000].End(xlUp))
    End With
    With WS2
        Set PlgWS2 = .Range(.[A2], .[A65000].End(xlUp))
    End With

    Set Plg = Union(PlgWS1, PlgWS2)
    For Each c In Plg
        If Not mondico.Exists(c.Value) Then mondico1.Add c.Value, c.Value
    Next c
    Sheets("feuil3").[A2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)

    For Each c In WS3.Range(WS3.[A2], WS3.[A65000].End(xlUp))
        
        '-- Extration des valeurs depuis feuil1
        x = Application.Match(c, WS1.Columns(1), 0)
        If x > 0 Then
            c.Offset(, 2) = x.Offset(, 1)    'NCS
            c.Offset(, 4) = x.Offset(, 2)    'QS
            c.Offset(, 5) = x.Offset(, 3)    'QT
        End If

        '-- Extration des valeurs depuis feuil2
        x = Application.Match(c, WS2.Columns(1), 0)
        If x > 0 Then
            c.Offset(, 1) = x.Offset(, 1)    'NVD
            c.Offset(, 3) = x.Offset(, 2)    'TRF
        End If
    Next c
End Sub

Sub CmbnTab()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim Plg As Range, PlgWS1 As Range, PlgWS2 As Range

    Set mondico = CreateObject("Scripting.Dictionary")

    Set WS1 = Sheets("feuil1")
    Set WS2 = Sheets("feuil2")
    Set WS3 = Sheets("feuil3")

    With WS1
        Set PlgWS1 = .Range(.[A2], .[A65000].End(xlUp))
    End With
    With WS2
        Set PlgWS2 = .Range(.[A2], .[A65000].End(xlUp))
    End With

    Set Plg = Union(Range(PlgWS1.Address), Range(PlgWS2.Address))
    
    For Each c In Plg
        If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
    Next c

    With WS3
        .[A2:F100].ClearContents
        .[A2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
    End With

    For Each c In WS3.Range(WS3.[A2], WS3.[A65000].End(xlUp))

        '-- Extration des valeurs depuis feuil1
        With WS1
            x = Application.Match(c, .Columns(1), 0)
            If Not IsError(x) Then
                If x > 0 Then
                    c.Offset(, 2) = .Range("A" & x).Offset(, 1)    'NCS
                    c.Offset(, 4) = .Range("A" & x).Offset(, 2)    'QS
                    c.Offset(, 5) = .Range("A" & x).Offset(, 3)    'QT
                End If
            End If
        End With
        '-- Extration des valeurs depuis feuil2
        With WS2
            x = Application.Match(c, .Columns(1), 0)
            If Not IsError(x) Then
                If x > 0 Then
                    c.Offset(, 1) = .Range("A" & x).Offset(, 1)    'NVD
                    c.Offset(, 3) = .Range("A" & x).Offset(, 2)    'TRF
                End If
            End If
        End With
    Next c
End Sub