Pour Patrice Henrio : Suite question precedente

Il faut éviter des personnaliser les réponses et demandes.
D'autres que moi sont largement aussi compétents pour répondre.

Pour ton programme, voici ce que je te propose

Sub Totalpoints()
Dim ResultatEBL As Range
Dim ResultatTop As Range
Dim JoueurEBL As Range
Dim JoueutTop As Range
Dim cpt As Integer
j = 8
For k = 3 To Sheets.Count
Sheets("Classement").Cells(k + 5, 1)= Worksheets(k).Name
'Worksheets(k).Select
cpt = 1
Set ResultatEBL = Worksheets(k).Range("G59:J60")
For Each JoueurEBL In ResultatEBL
For i = 2 To 9
'Worksheets(k).Select
If JoueurEBL = Worksheets("Classement").Cells(3, i) Then
Select Case cpt
Case Is < 5
Worksheets("Classement").Cells(j, i) =
JoueurEBL.Offset(2, 0)
Case Is > 4
Worksheets("Classement").Cells(j, i) =
JoueurEBL.Offset(1, 0)
End Select
Exit For
End If
Next i
cpt = cpt + 1
Next
'Calcul des points "Top"
'Worksheets(k).Select
cpt = 1
Set ResultatTop = Worksheets(k).Range("O59:R60")
For Each JoueurTop In ResultatTop
For i = 11 To 18
'Worksheets(k).Select
If JoueurTop = Worksheets("Classement").Cells(3, i) Then
Select Case cpt
Case Is < 5
Worksheets("Classement").Cells(j, i) =
JoueurTop.Offset(2, 0)
Case Is > 4
Worksheets("Classement").Cells(j, i) =
JoueurTop.Offset(1, 0)
End Select
Exit For
End If
Next i
cpt = cpt + 1
Next
j = j + 1
Next k
'Sheets("Classement").Select
End Sub

A mon avis tu ne devrais plus voir défiler les feuilles, mais je peux me
tromper. En programmation rien ne remplace les essais personnels.

"crisben" <crisben@discussions.microsoft.com> a écrit dans le message de
news: 41B9C79C-90EA-4583-A4F5-56B449429164@microsoft.com...

Merci de votre réponse.
En effet j'utilise "Select" pour aller rechercher les infos de caque
feuiile
pour
les placer ensuite dans la feuille recapitulative"Classement".
Voici le code que j'utlise:

Sub Totalpoints()
Dim ResultatEBL As Range
Dim ResultatTop As Range
Dim JoueurEBL As Range
Dim JoueutTop As Range
Dim cpt As Integer
j = 8
For k = 3 To Sheets.Count
Sheets("Classement").Cells(k + 5, 1).Value = Worksheets(k).Name
Worksheets(k).Select
cpt = 1
Set ResultatEBL = Range("G59:J60")
For Each JoueurEBL In ResultatEBL
For i = 2 To 9
Worksheets(k).Select
If JoueurEBL = Worksheets("Classement").Cells(3, i) Then
Select Case cpt
Case Is < 5
Worksheets("Classement").Cells(j, i) = JoueurEBL.Offset(2,
0)
Case Is > 4
Worksheets("Classement").Cells(j, i) = JoueurEBL.Offset(1,
0)
End Select
Exit For
End If
Next i
cpt = cpt + 1
Next
'Calcul des points "Top"
Worksheets(k).Select
cpt = 1
Set ResultatTop = Range("o59:R60")
For Each JoueurTop In ResultatTop
For i = 11 To 18
Worksheets(k).Select
If JoueurTop = Worksheets("Classement").Cells(3, i) Then
Select Case cpt
Case Is < 5
Worksheets("Classement").Cells(j, i) = JoueurTop.Offset(2,
0)
Case Is > 4
Worksheets("Classement").Cells(j, i) = JoueurTop.Offset(1,
0)
End Select
Exit For
End If
Next i
cpt = cpt + 1
Next
j = j + 1
Next k
Sheets("Classement").Select
End Sub

Encore merci pour votre aide.
Bon Dimanche.
Crisben

Bonsoir,
Pour optimiser le code, évite les sélections inutiles qui ralentissent
l'exécution. Dans Excel il n'est pas nécessaire de sélectionner un objet
pour travailler dessus, il suffit d'y faire référence [une variable objet de
type WorkSheet : Set Fe = WorkSheets("Nom de ma feuille")]. Les sélections
successives provoque des flashs gênant pour l'utilisateur. Pour éviter ces
derniers, utilise "Application.ScreenUpdating = False" avant les sélections
pour qu'il n'y ai pas
de rafraîchissement de l'écran (ce qui d'ailleurs augmente la vitesse
d'exécution) et une fois tes sélections finies, mets à
"Application.ScreenUpdating = True".
Attention, quand tu utilise "Sheets" ça fait aussi référence
aux feuilles graphiques et peut alors causer des erreurs. Si tu veux faire
référence aux feuilles de calcul, utilise plutôt WorkSheets ("s" à la fin
pour la collection).
J'ai un peu modifier ton code mais je ne l'ai pas testé en plein (je ne
voulais pas
me casser la tête à créer les feuilles correspondantes) :

Sub Totalpoints()
Dim FeCls As Worksheet
Dim Fe As Worksheet
Dim ResultatEBL As Range
Dim ResultatTop As Range
Dim JoueurEBL As Range
Dim JoueurTop As Range
Dim cpt As Integer
Dim J As Integer
Dim I As Integer
Dim K As Integer

J = 8
Set FeCls = Worksheets("Classement")
With FeCls
For K = 3 To Worksheets.Count
Set Fe = Worksheets(K)
.Cells(K + 5, 1).Value = Fe.Name
cpt = 1
Set ResultatEBL = Fe.[G59:J60]
For Each JoueurEBL In ResultatEBL
For I = 2 To 9
If JoueurEBL = .Cells(3, I) Then
Select Case cpt
Case Is < 5
.Cells(J, I) = JoueurEBL.Offset(2, 0)
Case Is > 4
.Cells(J, I) = JoueurEBL.Offset(1, 0)
End Select
Exit For
End If
Next I
cpt = cpt + 1
Next
'Calcul des points "Top"
cpt = 1
Set ResultatTop = Fe.[O59:R60]
For Each JoueurTop In ResultatTop
For I = 11 To 18
If JoueurTop = .Cells(3, I) Then
Select Case cpt
Case Is < 5
.Cells(J, I) = JoueurTop.Offset(2, 0)
Case Is > 4
.Cells(J, I) = JoueurTop.Offset(1, 0)
End Select
Exit For
End If
Next I
cpt = cpt + 1
Next
J = J + 1
Next K
.Select
End With

Set ResultatEBL = Nothing
Set ResultatTop = Nothing
Set JoueurEBL = Nothing
Set JoueurTop = Nothing
Set FeCls = Nothing
Set Fe = Nothing
End Sub

Hervé.

"crisben" <crisben@discussions.microsoft.com> a écrit dans le message news:
41B9C79C-90EA-4583-A4F5-56B449429164@microsoft.com...

Merci de votre réponse.
En effet j'utilise "Select" pour aller rechercher les infos de caque

feuiile

pour
les placer ensuite dans la feuille recapitulative"Classement".
Voici le code que j'utlise:

Sub Totalpoints()
Dim ResultatEBL As Range
Dim ResultatTop As Range
Dim JoueurEBL As Range
Dim JoueutTop As Range
Dim cpt As Integer
j = 8
For k = 3 To Sheets.Count
Sheets("Classement").Cells(k + 5, 1).Value = Worksheets(k).Name
Worksheets(k).Select
cpt = 1
Set ResultatEBL = Range("G59:J60")
For Each JoueurEBL In ResultatEBL
For i = 2 To 9
Worksheets(k).Select
If JoueurEBL = Worksheets("Classement").Cells(3, i) Then
Select Case cpt
Case Is < 5
Worksheets("Classement").Cells(j, i) = JoueurEBL.Offset(2,

0)

Case Is > 4
Worksheets("Classement").Cells(j, i) = JoueurEBL.Offset(1,

0)

End Select
Exit For
End If
Next i
cpt = cpt + 1
Next
'Calcul des points "Top"
Worksheets(k).Select
cpt = 1
Set ResultatTop = Range("o59:R60")
For Each JoueurTop In ResultatTop
For i = 11 To 18
Worksheets(k).Select
If JoueurTop = Worksheets("Classement").Cells(3, i) Then
Select Case cpt
Case Is < 5
Worksheets("Classement").Cells(j, i) = JoueurTop.Offset(2,

0)

Case Is > 4
Worksheets("Classement").Cells(j, i) = JoueurTop.Offset(1,

0)

End Select
Exit For
End If
Next i
cpt = cpt + 1
Next
j = j + 1
Next k
Sheets("Classement").Select
End Sub

Encore merci pour votre aide.
Bon Dimanche.
Crisben

Bonsoir

Un grand merci pour votre aide car tout cela fonctionne très bien.

Bonne soirée.
Crisben

"Hervé" a écrit :

Bonsoir,
Pour optimiser le code, évite les sélections inutiles qui ralentissent
l'exécution. Dans Excel il n'est pas nécessaire de sélectionner un objet
pour travailler dessus, il suffit d'y faire référence [une variable objet de
type WorkSheet : Set Fe = WorkSheets("Nom de ma feuille")]. Les sélections
successives provoque des flashs gênant pour l'utilisateur. Pour éviter ces
derniers, utilise "Application.ScreenUpdating = False" avant les sélections
pour qu'il n'y ai pas
de rafraîchissement de l'écran (ce qui d'ailleurs augmente la vitesse
d'exécution) et une fois tes sélections finies, mets à
"Application.ScreenUpdating = True".
Attention, quand tu utilise "Sheets" ça fait aussi référence
aux feuilles graphiques et peut alors causer des erreurs. Si tu veux faire
référence aux feuilles de calcul, utilise plutôt WorkSheets ("s" à la fin
pour la collection).
J'ai un peu modifier ton code mais je ne l'ai pas testé en plein (je ne
voulais pas
me casser la tête à créer les feuilles correspondantes) :

Sub Totalpoints()
Dim FeCls As Worksheet
Dim Fe As Worksheet
Dim ResultatEBL As Range
Dim ResultatTop As Range
Dim JoueurEBL As Range
Dim JoueurTop As Range
Dim cpt As Integer
Dim J As Integer
Dim I As Integer
Dim K As Integer

J = 8
Set FeCls = Worksheets("Classement")
With FeCls
For K = 3 To Worksheets.Count
Set Fe = Worksheets(K)
.Cells(K + 5, 1).Value = Fe.Name
cpt = 1
Set ResultatEBL = Fe.[G59:J60]
For Each JoueurEBL In ResultatEBL
For I = 2 To 9
If JoueurEBL = .Cells(3, I) Then
Select Case cpt
Case Is < 5
.Cells(J, I) = JoueurEBL.Offset(2, 0)
Case Is > 4
.Cells(J, I) = JoueurEBL.Offset(1, 0)
End Select
Exit For
End If
Next I
cpt = cpt + 1
Next
'Calcul des points "Top"
cpt = 1
Set ResultatTop = Fe.[O59:R60]
For Each JoueurTop In ResultatTop
For I = 11 To 18
If JoueurTop = .Cells(3, I) Then
Select Case cpt
Case Is < 5
.Cells(J, I) = JoueurTop.Offset(2, 0)
Case Is > 4
.Cells(J, I) = JoueurTop.Offset(1, 0)
End Select
Exit For
End If
Next I
cpt = cpt + 1
Next
J = J + 1
Next K
.Select
End With

Set ResultatEBL = Nothing
Set ResultatTop = Nothing
Set JoueurEBL = Nothing
Set JoueurTop = Nothing
Set FeCls = Nothing
Set Fe = Nothing
End Sub

Hervé.

"crisben" <crisben@discussions.microsoft.com> a écrit dans le message news:
41B9C79C-90EA-4583-A4F5-56B449429164@microsoft.com...
> Merci de votre réponse.
> En effet j'utilise "Select" pour aller rechercher les infos de caque
feuiile
> pour
> les placer ensuite dans la feuille recapitulative"Classement".
> Voici le code que j'utlise:
>
> Sub Totalpoints()
> Dim ResultatEBL As Range
> Dim ResultatTop As Range
> Dim JoueurEBL As Range
> Dim JoueutTop As Range
> Dim cpt As Integer
> j = 8
> For k = 3 To Sheets.Count
> Sheets("Classement").Cells(k + 5, 1).Value = Worksheets(k).Name
> Worksheets(k).Select
> cpt = 1
> Set ResultatEBL = Range("G59:J60")
> For Each JoueurEBL In ResultatEBL
> For i = 2 To 9
> Worksheets(k).Select
> If JoueurEBL = Worksheets("Classement").Cells(3, i) Then
> Select Case cpt
> Case Is < 5
> Worksheets("Classement").Cells(j, i) = JoueurEBL.Offset(2,
0)
> Case Is > 4
> Worksheets("Classement").Cells(j, i) = JoueurEBL.Offset(1,
0)
> End Select
> Exit For
> End If
> Next i
> cpt = cpt + 1
> Next
> 'Calcul des points "Top"
> Worksheets(k).Select
> cpt = 1
> Set ResultatTop = Range("o59:R60")
> For Each JoueurTop In ResultatTop
> For i = 11 To 18
> Worksheets(k).Select
> If JoueurTop = Worksheets("Classement").Cells(3, i) Then
> Select Case cpt
> Case Is < 5
> Worksheets("Classement").Cells(j, i) = JoueurTop.Offset(2,
0)
> Case Is > 4
> Worksheets("Classement").Cells(j, i) = JoueurTop.Offset(1,
0)
> End Select
> Exit For
> End If
> Next i
> cpt = cpt + 1
> Next
> j = j + 1
> Next k
> Sheets("Classement").Select
> End Sub
>
> Encore merci pour votre aide.
> Bon Dimanche.
> Crisben