Déclencher 2 macros presque identiques avec un seul bouton

Bonjour

Je n'arrive pas a déclencher 2 macros avec un seul bouton

Je vous joins les 2 codes VBA presque identiques

Merci pour votre aide

Sub tirage()

Dim tTab, iRow%, iCol%, iNb%, iMod%, iNum%
Cancel = True'
iRow = Range("A" & Rows.Count).End(xlUp).Row
iNb = Fix((iRow - 1) / 5)
iMod = (iRow - 1) Mod 5 '
tTab = Range("A2:A" & iRow).Value
[D7:L10].ClearContents
iCol = 2
For x = 2 To iRow
    iTRow = 6
    iCol = iCol + 2
    iNum = iNum + 1
    For y = x To x + (iNb - 1) + IIf(iNum <= iMod, 1, 0)
        iTRow = iTRow + 1
        Do
            iRnd = Int((iRow - 1) * Rnd + 1)
        Loop Until CInt(tTab(iRnd, 1)) > 0
        Cells(iTRow, iCol) = tTab(iRnd, 1)
        tTab(iRnd, 1) = 0
    Next
    x = y - 1
Next
End Sub

Sub sort()
Dim tTab, iRow%, iCol%, iNb%, iMod%, iNum%
Cancel = True'
iRow = Range("A" & Rows.Count).End(xlUp).Row
iNb = Fix((iRow - 1) / 5)
iMod = (iRow - 1) Mod 5 '
tTab = Range("A2:A" & iRow).Value
[D2:L5].ClearContents
iCol = 2
For x = 2 To iRow
    iTRow = 2
    iCol = iCol + 2
    iNum = iNum + 1
    For y = x To x + (iNb - 1) + IIf(iNum <= iMod, 1, 0)
        iTRow = iTRow + 1
        Do
            iRnd = Int((iRow - 1) * Rnd + 1)
        Loop Until CInt(tTab(iRnd, 1)) > 0
        Cells(iTRow, iCol) = tTab(iRnd, 1)
        tTab(iRnd, 1) = 0
    Next
    x = y - 1
Next

End Sub

Bonjour à tous!

Joco7915...Pourquoi ne pas mettre en Private Sub Sort et ensuite placer Sort juste avant end sub dans la macro Tirage ?

Sub tirage()
Dim tTab, iRow%, iCol%, iNb%, iMod%, iNum%
Cancel = True '
iRow = Range("A" & Rows.Count).End(xlUp).Row
iNb = Fix((iRow - 1) / 5)
iMod = (iRow - 1) Mod 5 '
tTab = Range("A2:A" & iRow).Value
[D7:L10].ClearContents
iCol = 2
For x = 2 To iRow
    iTRow = 6
    iCol = iCol + 2
    iNum = iNum + 1
    For y = x To x + (iNb - 1) + IIf(iNum <= iMod, 1, 0)
        iTRow = iTRow + 1
        Do
            iRnd = Int((iRow - 1) * Rnd + 1)
        Loop Until CInt(tTab(iRnd, 1)) > 0
        Cells(iTRow, iCol) = tTab(iRnd, 1)
        tTab(iRnd, 1) = 0
    Next
    x = y - 1
Next
'PLACER SORT ICI
sort
End Sub

Private Sub sort()
Dim tTab, iRow%, iCol%, iNb%, iMod%, iNum%
Cancel = True '
iRow = Range("A" & Rows.Count).End(xlUp).Row
iNb = Fix((iRow - 1) / 5)
iMod = (iRow - 1) Mod 5 '
tTab = Range("A2:A" & iRow).Value
[D2:L5].ClearContents
iCol = 2
For x = 2 To iRow
    iTRow = 2
    iCol = iCol + 2
    iNum = iNum + 1
    For y = x To x + (iNb - 1) + IIf(iNum <= iMod, 1, 0)
        iTRow = iTRow + 1
        Do
            iRnd = Int((iRow - 1) * Rnd + 1)
        Loop Until CInt(tTab(iRnd, 1)) > 0
        Cells(iTRow, iCol) = tTab(iRnd, 1)
        tTab(iRnd, 1) = 0
    Next
    x = y - 1
Next

End Sub

Bonjour

Merci pour ta réponse

mais je viens de voir en déclenchant manuellement et indépendamment chaque macro

que cela ne correspond pas à ce que je veux obtenir.

Cordialement

Re-Bonjour

Joco7915

Les 2 macros se déclenchent avec 1 seul bouton...ce n'est pas ce que vous espériez ?

Si mais il s'agit de tirage au sort et j'ai des doublons d’où mon nouveau post avec fichier joint

Rechercher des sujets similaires à "declencher macros presque identiques seul bouton"