Aide à la création de code pour afficher certaines valeurs pendant une cert

Bonjour à tous 🖐 S'il vous plaît aider à compléter le code. Je veux afficher les chiffres de la feuille 2 dans le champ A1 en séquence pendant une seconde. J'ai créé ce code car le compteur fonctionne en calculant les nombres à partir du numéro 1 jusqu'à la dernière cellule de la colonne ..... Ce qu'il faut, c'est le compteur selon les chiffres existants Dans le papier 2.. Merci

Sub cal()
Dim LastRow As Long
Dim i As Long, j As Long
Application.Calculation = xlManual
With Worksheets("Feuil2")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
End With
For i = 1 To LastRow
With Worksheets("sh1")
Application.Wait (Now + TimeValue("00:00:01"))
Range("A2").Value = i

End With
Next i
Application.Calculation = xlAutomatic
End Sub

Bonjour,

Il semble plus approprié de coller toutes les valeurs directement et de les conserver ensuite, sachant qu'il prend 2 secondes à l'utilisateur de les supprimer le cas échéant.

Voici une alternative avec copie de toutes les valeurs en colonne 1 de la feuille 1 puis une macro évènementielle pour parcourir une à une les valeurs obtenues :

'Code à placer dans un module standard
Sub cal()
Dim dl&
With Worksheets("Feuil2")
    dl = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
    Worksheets("sh1").Range("A2").resize(dl).Value = .columns(1).resize(dl).value
    application.goto worksheets("sh1").range("A2")
End With
End Sub

'Code à placer dans le module de la "sh1"
private sub worksheet_selectionchange(byval target as range)
dim r as range
with me
    dl = .cells(.rows.count, 1).end(xlup).row
    set r = intersect(target, .columns(1).resize(dl))
    if not r is nothing then
        if r.cells.count = 1 then
            PrevColor = r.interior.color
            r.interior.color = vbgreen
            application.wait now + timevalue("00:00:01")
            r.interior.color = PrevColor
            r.offset(1).activate
        end if
    end if
end with
end sub

Cdlt,

Merci Bonne idée même si j'aurais aimé le montrer dans le même champ en séquence Y a-t-il une possibilité de cela

Bonjour,

Dans ce cas, votre code légèrement modifié semble suffire :

Sub cal()
Dim dl&, i&
Application.Calculation = xlManual
application.goto worksheets("sh1").range("A1")
With Worksheets("Feuil2")
    dl = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
    For i = 1 To dl
        Application.Wait (Now + TimeValue("00:00:01"))
        Worksheets("sh1").Range("A1").Value = .cells(i, 1).value
    Next i
end with
Application.Calculation = xlAutomatic
End Sub

Cdlt,

Génial 👏👏👏 C'est exactement ce qu'il faut. Merci de l'intérêt que vous portez à ma demande