Option Explicit
Sub macro1()
Dim o As Worksheet, z As Worksheet, cel As Range, dest As Range, x As Range, y As Byte
Dim t() As Variant, i As Byte
Set o = Worksheets("Source")
Set z = Worksheets("Tab.avant")
t = Array(1, 2, 3, 7, 9)
For Each cel In o.Range("A2:A" & o.Range("E65536").End(xlUp).Row)
If cel.Value <> "" Then
Set x = z.Range("A2:A" & z.Range("A65536").End(xlUp).Row).Find(cel.Value, , xlValues, xlWhole, , , False)
If x Is Nothing Then
If cel.Value <> z.Range("A1") Then
y = z.Cells.Find("*", , xlValues, , 1, 2, 0).Row + 1
For i = LBound(t) To UBound(t)
Set dest = z.Rows(1).Find(o.Cells(1, t(i)).Value, , xlValues, xlWhole, , , False)
If Not dest Is Nothing Then o.Cells(cel.Row, t(i)).Copy z.Cells(y, dest.Column)
Next i
End If
End If
End If
Next cel
End Sub