Copy des cellules

Bonjour,

merci de votre aide pour copie des cellules

Sub test()
'la valeur A1 soit copier sur D1
'la valeur B1 soit copier sur E1
'la valeur c1 soit copier sur E2 ???? F1 oui
With Worksheets("feuil1")
Var = InputBox("Mot à rechercher ?")
For Each Cell In Range("A1:A10")
If Cell.Value = Var Then
Cell.Copy Cell.Offset(0, 3)
Cell.Offset(0, 1).Copy Cell.Offset(0, 4)
Cell.Offset(0, 2).Copy Cell.Offset(0, 5)
Exit For
End If
Next Cell
End With
End Sub
............................................................................

voici un tableau parlant:
............................................................................

A1:A10... civilite .......nom ....prenom ...age ...ville
100 .... homme....... toto.... paul.......22.... paris
200 ...... femme........ fifi... catherine ...33.... marseille
.....................................................................
300....... homme .......papy.....jean...... 77...... lyon
400...... femme........ mimi.....severine..88...... bordeaux
.....................................................................
resultat sur la feuille2:apres avoir lancer la macro
...................................................................

nom du jeune homme... toto.... age.... 22
prenom jeune homme... paul..... ville... paris
...................................................................
nom du jeune fille........ fifi..... age..... 33
prenom du jeune..... catherine... ville ...marseille