Croiser deux Code VBA

Private Sub Worksheet_Calculate()
Dim r As Range, limite, decharge&, nc&, d As Object
Dim c As Range, bleu As Range, n&
Set r = [A1:A30]
limite = [D2]
decharge = 500
nc = r.Count
r.Interior.ColorIndex = xlNone 'RAZ
Randomize
Set d = CreateObject("Scripting.Dictionary")
While d.Count < limite
  Set c = r(Int(1 + Rnd * nc))
  If Not d.exists(c.Value) Then
    d(c.Value) = ""
    Set bleu = Union(c, IIf(bleu Is Nothing, c, bleu))
    n = n + 1
    If n Mod decharge = 0 Then 'décharge
      bleu.Interior.ColorIndex = 47 'bleu
      Set bleu = Nothing
    End If
  End If
Wend
If Not bleu Is Nothing Then bleu.Interior.ColorIndex = 47  'bleu
If Not c Is Nothing Then c.Interior.ColorIndex = 3 'rouge
End Sub

Sub Tirage()
Dim r As Range, cible, ncoul As Range, nc&, d As Object, c As Range
Set r = [A1:A30] 'plage à adapter
cible = 4 or 5 'à adapter
Set ncoul =  [E2]'nombre de tirages total 
r.Interior.ColorIndex = xlNone 'RAZ
ncoul = ""
If Application.CountIf(r, cible) = 0 Then _
  MsgBox "Valeur cible introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Randomize
nc = r.Count
Set d = CreateObject("Scripting.Dictionary")
Do
  Set c = r(Int(1 + Rnd * nc))
  If c <> "" And Not d.exists(c.Value) Then
    d(c.Value) = ""
    c.Interior.ColorIndex = 47 'bleu
  End If
Loop While c <> cible
c.Interior.ColorIndex = 3 'rouge
ncoul = d.Count
End Sub