Sub macro1()
Dim o As Worksheet, z As Worksheet, cel As Range, dest As Range, x As Range
Dim t() As Variant, i As Byte
Set o = Worksheets("Source")
Set z = Worksheets("Tab.avant")
t = Array(1, 2, 3, 4, 5, 8, 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
For i = LBound(t) To UBound(t)
Set dest = z.Rows(1).Find(o.Cells(1, i + 1).Value, , xlValues, xlWhole, , , False)
If Not dest Is Nothing Then o.Cells(cel.Row, i + 1).Copy z.Cells(z.Cells(65536, _
dest.Column).End(xlUp).Row, dest.Column)
Next i
End If
End If
End If
Next cel
End Sub