Choix aléatoire

Bonjour à toutes et tous

Je voudrais que mon PC choisisse, de manière aléatoire, plusieurs mots (j'en décide le nombre moi-même), dans une liste (étant entendu que j'ai enregistré au préalable une série de mots - un mot par cellule - dans une feuille). Est-ce clair ? Qui peut m'aider ? Merci.

Bonjour

Qui peut m'aider ?

inutile de demander..la réponse est évidente. Tu es sur un Forum d'entr'aide!!

Tu parles de la feuille..

Cela signifie-t-il que tes mots sont n'importe-où sur la feuille ou sont ils dans une plage délimitée et combiens de mots?

De plus, tu veux afficher ces mots dans une cellule ou les mettre en évidence sur ton tableau?

Le mieux serait que tu envoies ton fichier

Cordialement

Merci pour ta réponse.

J'ai essayé de joindre ma feuille Excel à ce message, mais je n'y suis pas arrivé ... Alors je recopie ...

Prénom Nom Prénom choisi Nom correspondant

Jean Némar Choix n° 1 Nom du choix n° 1

Pierre Tombale Choix n° 2 Nom du choix n° 2

Marc Tapage Choix n° 3 Nom du choix n° 3

Thomas Tepelé

Marion Nous

Cécile Mafille

Un prénom par cellule, les noms correspondants dans les cellules voisines.

Le but : choisir au hasard quelques prénoms (j'en décide le nombre à chaque fois), les recopier dans une colonne et dans la colonne voisine les noms correspondants.

Merci. Bonne journée !

Bonjour

Pour joindre un fichier, regarde à la fin de cette page

https://forum.excel-pratique.com/excel/explications-et-regles-a-respecter-t13.html

Cordialement

Bonjour,

Regarde le fichier joint...

Le code :

Sub tirage()
Dim NbChoix As Byte, Num As Byte, LeMax As Byte
Dim LeNombre As Object
Dim It
Set LeNombre = CreateObject("Scripting.Dictionary")
LeMax = [A65000].End(xlUp).Row - 1
debut:
NbChoix = InputBox("Entrez une valeur comprise entre 1 et " & LeMax)
If NbChoix > LeMax Then GoTo debut
Do While LeNombre.Count < NbChoix
    Randomize Timer
    Num = Int((NbChoix * Rnd) + 1)
    LeNombre(Num) = Num
Loop
Range("D2:E100").ClearContents
For Each It In LeNombre.Items
    [D65000].End(xlUp)(2) = Cells(It + 1, 1).Value
    [E65000].End(xlUp)(2) = Cells(It + 1, 2).Value
Next It
End Sub

Bonne journée