Twee adressenlijsten samenvoegen en aanvullen

[Etkroket]

Beste forumleden,

Graag uw hulp bij het volgende.

Ik heb 2 adressenlijsten:
* 1 lijst met een selectie adressen, zonder aanhef (dhr. of mevr)
* 1 volledige lijst met alle adressen inclusief aanhef.

Bijkomend punt is dat de opmaak van de lijsten niet hetzelfde is, zie bijgevoegd bestand.
Vraag: is het mogelijk om vanuit de volledige lijst de aanhef te kopieren naar de selectielijst zodat ik daar een lijst krijg inclusief aanhef?

Ik hoor het graag!
Groet.

 

[Warme bakkertje]

Sub tst()
    Dim sq As Variant
    ReDim sq(0 To 1000)
    i = 0
    With Sheets("Selectie")
    For Each cl In .Range("D2:D" & .Cells(Rows.Count, 4).End(xlUp).Row)
        sq(i) = Trim(cl & "," & cl.Offset(, -2) & " " & cl.Offset(, -1))
        i = i + 1
    Next
    ReDim Preserve sq(1 To i)
    .[H2].Resize(i) = Application.Transpose(sq)
    On Error Resume Next
    For Each cl In .Range("H2:H" & .Cells(Rows.Count, 8).End(xlUp).Row)
       cl.Offset(, -7) = Sheets("Volledige lijst").Columns(2).Find(cl, , xlValues, xlWhole).Offset(, -1).Value
    Next
    .Columns(8).ClearContents
    End With
End Sub

 

[Etkroket]

Bedankt voor de hulp!