Sub Test_V2()
'Variables
Dim t As Variant, i&, lgDeb&, nCopy&, item$
'valeurs dans l'array
Application.ScreenUpdating = False
'Copier coller la liste des joueurs et le nombre de fois sur la feuille 4
Sheets("Tableau").Select
Range("l3:n12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("d:d").Select
Selection.Cut
Columns("A:A").Select
ActiveSheet.Paste
Columns("C:C").Delete
Range("C1").Select
t = Range("a1").CurrentRegion
lgDeb = 1 'début ligne
'boucle
For i = 1 To UBound(t, 1)
item = t(i, 2): nCopy = t(i, 1) - 1
If nCopy > -1 Then
Range("d" & lgDeb & ":d" & (lgDeb + nCopy)).Value = item 'recopie en colonne d
lgDeb = lgDeb + nCopy + 1 'incrément
Range("D1").Select
Range(Selection, Selection.End(xlDown)).Select
End If
Next
Dim TSrc(), RngCbl As Range, TCbl(), LSrc As Long, CSrc As Long, LCbl As Long, CCbl As Long
TSrc = Selection.Value
On Error Resume Next
Set RngCbl = Range("f1:i30")
If Err Then Exit Sub
On Error GoTo 0
ReDim TCbl(1 To RngCbl.Rows.Count, 1 To RngCbl.Columns.Count)
CCbl = 1
For CSrc = 1 To UBound(TSrc, 2)
For LSrc = 1 To UBound(TSrc, 1): LCbl = LCbl + 1
If LCbl > UBound(TCbl, 1) Then
LCbl = 1: CCbl = CCbl + 1: If CCbl > UBound(TCbl, 2) Then Exit For
End If
TCbl(LCbl, CCbl) = TSrc(LSrc, CSrc): Next LSrc, CSrc
RngCbl.Value = TCbl
Range("F1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Tableau").Select
Range("c3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Feuil2").Select
Range("G1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tableau").Select
Range("e3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Feuil2").Select
Range("H1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tableau").Select
Range("g3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Feuil2").Select
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tableau").Select
Range("i3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Feuil2").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("Tableau").Select
Range("B2").Select
'Appel des macros "mixer_joueur" et les executer 5 fois chacune
For i = 1 To 5
Application.Run "Module1.Mixer_joueur_1"
Application.Run "Module1.Mixer_joueur_2"
Application.Run "Module1.Mixer_joueur_3"
Application.Run "Module1.Mixer_joueur_4"
Next
Application.ScreenUpdating = True
End Sub