Bonsoir le forum,

J'ai un ce code qui me classe les résultats des séries dans ma feuille Finale, le problème, comme c'est le même code qui me classe les résultats des séries dans la feuille demi finale, et que j'ai fait un copier coller de ce code, je voulais savoir ce qu'il faut changer pour qu'il me fasse un classement sur un poule de 6 lignes maxi car la , il me les classe en 2 poules.
j'espère avoir été assez explicite.
merci d'avance.
Voici le code

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Public Sub RESULT1_F(ByRef ws As Worksheet, ByVal num As Byte)
Dim sht As Worksheet, shtf As Worksheet
Dim LL As Integer, i As Integer, FinPrem As Integer
Dim LigF As Byte, ColF As Byte
Dim tour As Boolean
 
Application.ScreenUpdating = False
NbPoules = num
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = False
 
Set sht = Worksheets.Add
sht.Name = "Temp"
 
UsfDF2.Show
 
With ws
    For i = 1 To num
        .Range(.Cells(6, 5 * i - 4), .Cells(5 + Opt, 5 * i - 1)).Copy sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next i
        For i = 1 To num
        LL = .Cells(5, 5 * i - 4).End(xlDown).Row
        .Range(.Cells(6 + Opt, 5 * i - 4), .Cells(LL, 5 * i - 1)).Copy sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next i
End With
 
With sht
        FinPrem = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A" & Opt * num + 2 & ":D" & FinPrem).Sort Key1:=.Range("D" & Opt * num + 2), Order1:=xlAscending, Header:=xlNo
End With
 
LigF = 6: ColF = 1
tour = True
 
Set shtf = Sheets("Finales")
With shtf
    .Range("A6:D12").Clear 'Contents
    For i = 2 To NbF + 1
        sht.Range("A" & i & ":C" & i).Copy .Cells(LigF, ColF)
        tour = Not tour
        If tour Then
            LigF = LigF + 1
        Else
            ColF = IIf(ColF = 6, 1, 6)
        End If
    Next i
End With
 
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = False
shtf.Activate
Set sht = Nothing
Set shtf = Nothing
End Sub
jacky