amélioration de macro

[JJ1]

Bonsoir,
Tibo 'avait écrit ne macro de tirage aléatoire de 6 numéros.
En feuille 2 col A e B je peux saisir des nombres favoris ou interdits.
Elle fonctionne mais je voudrais apporter 2 modifs:
1- demander le nb de favoris souhaité (comme le nb de tirages)
2- n feuills 2 col C1à C3, possibilité de saisir de 1 à 3 nombres favoris "groupés" , ainsi toutes les combinaisons commenceraient par 1, 2 ou 3 nombres saisis dans cette colonne .

Voici la macro:

Sub Tirage()
nbreTirage = InputBox("Combien de tirages ?", "")
If nbreTirage = "" Then Exit Sub
Application.ScreenUpdating = False
[A:F].ClearContents
x1 = 1 'nbre mini
x2 = 49 'nbre maxi
lg = 1 '1° ligne tirage
longPlgFavoris = Application.CountA([Favoris])
For h = 1 To nbreTirage
z = 1 '1° colonne tirage
nb = [int(rand()*(3-1)+1)] 'Nbre aléatoire (entre 1 et 2) de tirages des favoris (plage nommée "Favoris")
Set plg1 = Range(Cells(lg, 1).Address & ":" & Cells(lg, 6).Address)
For i = 1 To nb 'tirage favoris
num = Application.Index([Favoris], Evaluate("int(rand()*(" & longPlgFavoris & "+1-1)+1)")) 'tirage aléatoire entre bornes
If Application.CountIf([plg1], num) > 0 Then 'vérif doublons
i = i - 1
Else: Cells(lg, z) = num: z = z + 1
End If
Next i
z = nb + 1

For j = nb + 1 To 6 'tirage autres numéros
Set plg = Range(Cells(lg, 1).Address & ":" & Cells(lg, 6).Address)

nbFavoris = Evaluate("sum((" & plg.Address & "=Favoris)*1)")
leNum = Evaluate("int(rand()*(" & x2 + 1 & "-" & x1 & ")+" & x1 & ")")

If IsNumeric(Application.Match(leNum, [Favoris], 0)) _
Or Application.CountIf([plg], leNum) = 1 _
Or IsNumeric(Application.Match(leNum, [Interdits], 0)) Then 'vérification favoris, doublons, interdits
j = j - 1
Else: Cells(lg, z) = leNum: z = z + 1
End If
Next j
'tri croissant
plg.Sort Key1:=Cells(lg, 1), Order1:=xlAscending, Header:=xlGuess, Orientation:=xlLeftToRight
lg = lg + 1: z = 0
Next h
End Sub

Bonne soirée et merci encore