Copier cellules

Bonjour,

j'ai des cellules nomées sur une feuille, je voudrais suite à l'action sur un bouton lié à une macro, que ces cellules soient copiées sur une autre feuille autant de fois que je clique sur le bouton, j'ai bidouillé un truc qui fonctionne, mais qui ne me le copie qu'un seul fois.

Sub Liste()

    Dim shHisto As Worksheet
    Dim rgAujourdhui As Range
    Dim dAujourdhui As Date
    ' Recherche la feuille "Liste"
    On Error Resume Next
    Set shHisto = Sheets("Liste")
    On Error GoTo 0
    dAujourdhui = Date
        ' ...créer un nouvel enregistrement

            Set rgAujourdhui = shHisto.Cells().End(xlUp)

    ' Trajets
    rgAujourdhui.Offset(0, 0) = ActiveWorkbook.Names("Date").RefersToRange
    rgAujourdhui.Offset(0, 1) = ActiveWorkbook.Names("Nom").RefersToRange
    rgAujourdhui.Offset(0, 2) = ActiveWorkbook.Names("Depart").RefersToRange
    rgAujourdhui.Offset(0, 3) = ActiveWorkbook.Names("Km").RefersToRange
    rgAujourdhui.Offset(0, 4) = ActiveWorkbook.Names("Temps").RefersToRange
    rgAujourdhui.Offset(0, 5) = ActiveWorkbook.Names("Labo").RefersToRange
    rgAujourdhui.Offset(0, 6) = ActiveWorkbook.Names("Rexel").RefersToRange
    rgAujourdhui.Offset(0, 7) = ActiveWorkbook.Names("StFeyre").RefersToRange

End Sub

Merci de votre aide.

Bonjour

Essaie en modifiant cette instruction :

Set rgAujourdhui = shHisto.Cells().End(xlUp)(2)

Bye !

Merci,

mais ça ne fonctionne pas, je rajoute le fichier complet en pièce jointe.

Et comme cela ? :

Bye !