1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
| Function Derniere(Plage As Range) As Range
'Dim debut As Range
'Set debut = Range("E6")
Set Derniere = Plage.End(xlDown).Offset(1, 0)
End Function
Sub Piocher(NbCarte As Integer)
Dim LaPlage As Range
Dim LaDerniereCellule As Range
Set LaPlage = Range("E6") 'ThisWorkbook.Worksheets("Feuil1").Range("Main")
Application.CutCopyMode = False
Dim i As Integer
For i = 1 To NbCarte
Set LaDerniereCellule = Derniere(LaPlage)
Range("C6").Select
Selection.Copy
LaDerniereCellule.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C7:C65").Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C6:C65").Select
Selection.ClearContents
Range("B6:B64").Select
Selection.Copy
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B6:B64").Select
Selection.ClearContents
Next
Range("Q10").Select
End Sub
Sub Départ()
Application.ScreenUpdating = False
'on vide tout les emplacements
Range("Deck").ClearContents
Range("Main").ClearContents
Range("Champ").ClearContents
Range("Cimetière").ClearContents
Range("Exile").ClearContents
Range("Réserve").ClearContents
'on remplit le deck
Dim i As Integer
For i = 1 To 60
Range("C" & 5 + i).Value = i
Next
Call Mélange
Piocher (7)
Application.ScreenUpdating = True
End Sub
Sub Mélange()
Application.ScreenUpdating = False
Range("C6:D65").Select
Selection.AutoFilter
Selection.AutoFilter 'si je retire cette ligne les flèches de tri reste à la fin de la procédure
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D6:D65") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("C6:D65")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("Q5").Select
Application.ScreenUpdating = True
End Sub |
Partager