jacky49
XLDnaute Impliqué
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
jacky
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:
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