Copier des cellules sur la dernière cellule vide

[Gysmo]

Bonjour

Voici mon problème : J'ai une feuille "Base fiche client". Je veux faire une macro qui sélectionne des cellules de cette feuilles et les copie sur la dernière ligne vide de la feuille "feuil1".
Mon bouton macro est sur la feuille "Base fiche client"

Voici ma macro....amis elle ne fonctionne pas

Sub Bouton14_QuandClic()
Sheets("Feuil1").Select
Range("a65536").End(xlUp).Offset(1, 0).Select

ActiveCell.Offset(0, 2).Value = Sheets("Base fiche client").Range("b10")
ActiveCell.Offset(0, 3).Value = Sheets("Base fiche client").Range("c10")
ActiveCell.Offset(0, 4).Value = Sheets("Base fiche client").Range("d10")
ActiveCell.Offset(0, 5).Value = Sheets("Base fiche client").Range("e10")
ActiveCell.Offset(0, 6).Value = Sheets("Base fiche client").Range("f10")
ActiveCell.Offset(0, 7).Value = Sheets("Base fiche client").Range("g10")
ActiveCell.Offset(0, 8).Value = Sheets("Base fiche client").Range("h10")
ActiveCell.Offset(0, 9).Value = Sheets("Base fiche client").Range("i10")
ActiveCell.Offset(0, 10).Value = Sheets("Base fiche client").Range("j10")
ActiveCell.Offset(0, 11).Value = Sheets("Base fiche client").Range("k10")
ActiveCell.Offset(0, 12).Value = Sheets("Base fiche client").Range("l10")
ActiveCell.Offset(0, 13).Value = Sheets("Base fiche client").Range("m10")
ActiveCell.Offset(0, 14).Value = Sheets("Base fiche client").Range("b11")
ActiveCell.Offset(0, 15).Value = Sheets("Base fiche client").Range("c11")
ActiveCell.Offset(0, 16).Value = Sheets("Base fiche client").Range("d11")
ActiveCell.Offset(0, 17).Value = Sheets("Base fiche client").Range("e11")
ActiveCell.Offset(0, 18).Value = Sheets("Base fiche client").Range("f11")
ActiveCell.Offset(0, 19).Value = Sheets("Base fiche client").Range("g11")
ActiveCell.Offset(0, 20).Value = Sheets("Base fiche client").Range("h11")
ActiveCell.Offset(0, 21).Value = Sheets("Base fiche client").Range("i11")


ActiveWorkbook.Save
MsgBox " La fiche est créée "

End Sub

Merci

 

[Spitnolan08]

Re : Copier des cellules sur la dernière cellule vide

Bonjour,

Ainsi :

Private Sub Bouton14_Click()
Dim Dest as range
Set Dest = Sheets("Feuil1").Range("A65000").End(xlUp)

Dest.Offset(1, 2).Value = Sheets("Base fiche client").Range("b10")
Dest.Offset(1, 3).Value = Sheets("Base fiche client").Range("c10")
Dest.Offset(1, 4).Value = Sheets("Base fiche client").Range("d10")
Dest.Offset(1, 5).Value = Sheets("Base fiche client").Range("e10")
Dest.Offset(1, 6).Value = Sheets("Base fiche client").Range("f10")
Dest.Offset(1, 7).Value = Sheets("Base fiche client").Range("g10")
Dest.Offset(1, 8).Value = Sheets("Base fiche client").Range("h10")
Dest.Offset(1, 9).Value = Sheets("Base fiche client").Range("i10")
Dest.Offset(1, 10).Value = Sheets("Base fiche client").Range("j10")
Dest.Offset(1, 11).Value = Sheets("Base fiche client").Range("k10")
Dest.Offset(1, 12).Value = Sheets("Base fiche client").Range("l10")
Dest.Offset(1, 13).Value = Sheets("Base fiche client").Range("m10")
Dest.Offset(1, 14).Value = Sheets("Base fiche client").Range("b11")
Dest.Offset(1, 15).Value = Sheets("Base fiche client").Range("c11")
Dest.Offset(1, 16).Value = Sheets("Base fiche client").Range("d11")
Dest.Offset(0, 17).Value = Sheets("Base fiche client").Range("e11")
Dest.Offset(0, 18).Value = Sheets("Base fiche client").Range("f11")
Dest.Offset(0, 19).Value = Sheets("Base fiche client").Range("g11")
Dest.Offset(0, 20).Value = Sheets("Base fiche client").Range("h11")
Dest.Offset(0, 21).Value = Sheets("Base fiche client").Range("i11")


ActiveWorkbook.Save
MsgBox " La fiche est créée "

End Sub

Sans chercher de simplification, ca devrait mieux marcher

Cordialement