reduction de code

salut a tous,

j'ai un code qui me semble peut etre améliorer puisqu'il s'agit de copier/coller valeur successifs. Je veux prendre deux cellules distinctes sur une feuille et les coller sur une autre feuille dans deux cellules qui se touchent des colonnes b et c. et je fais l'opération deux fois de suite.

Sub test()

Sheets("données VL et Histo").Select
Range("A5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("6100018").Select
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("données VL et Histo").Select
Range("B16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("6100018").Select
Range("C65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("données VL et Histo").Select
Range("A5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("6100065").Select
Range("B65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("données VL et Histo").Select
Range("C16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("6100065").Select
Range("C65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Est ce que l'un d'entre vous connait un moyen de le reduire sans tout foutre en l'air. C'est un général se qui se passe quand je retouche des trucs qui marchent!

merci à tous