Exécution macro auto avec temps voulu

Bonjour,

Je viens vers vous pour savoir si mon idée est réalisable

J'ai un fichier (ci-joint) dont je voudrais pouvoir exécuter la macro avec des temps donnés, je m'explique :

j'ai une macro qui va piocher une ligne au hasard dans un tableau sur ma feuille "Bdd" et qui la copie sur la feuille "Test" et cela à chaque fois que l'on clic sur un bouton, jusque là tout est ok

Mais je viens d'avoir une idée ^^, je voudrais maintenant lorsque l'on clic sur le bouton que la macro s'exécute automatiquement toutes les x minutes. Ces x minutes seront définies sur ma feuille "Bdd" donc jamais la même

Merci d'avance

J'ai réussi à avancer un peu en mettant un timer dans mon fichier qui se lance quand on clic sur le bouton mais il est figé dans mon code vba :/

Je voudrais pouvoir choisir plusieurs durées dans l'onglet "Bdd", les unes après les autres comme sur le fichier joint et pouvoir le stopper en le réinitialisant avec mon bouton "RAZ"

Merci d'avance

Salut Seb,

une proposition à tester en situation réelle.

Pour les besoins de la cause, j'ai modifié les valeurs de ta colonne "D" en 'Bdd', du format HEURE à INTEGER représentant les minutes de délai entre chaque exécution.

J'ai choisi de "faire tourner" tes valeurs-délais qui se succéderont donc à l'infini si tu ne stoppes pas l'affaire.

Tu comprendras en parcourant la macro, placée en Module1 et appelée dès l'ouverture du classeur.

Pour arrêter le Timer, ton bouton RAZ place un "0" en bas de ta liste de délais : quand le Timer repasse par la macro et lit le "0", le processus est stoppé.

Sub MacroAuto()
'
Dim dChrono As Date
Dim iRow%
Dim sFlag As String
'
'ici, ton traitement sur les lignes de ta feuille
'
With Worksheets("Bdd")
    .Range("D2").Insert shift:=xlDown
    iRow = .Cells(Rows.Count, 4).End(xlUp).Row
    .Cells(2, 4) = .Cells(iRow, 4)
    .Cells(iRow, 4) = ""
    If Cells(2, 4) > 0 Then
        sFlag = "00:" & CStr(.Cells(2, 4)) & ":00"
        dChrono = Now + TimeValue(sFlag)
        Application.OnTime dChrono, "MacroAuto"
    Else
        .Cells(2, 4).Delete shift:=xlUp
    End If
End With
'
End Sub

A+