macro "autofilter"

[Christian]

Bonjour à tous,
Dans le programme que j'ai réalisé, pour le classement par équipe, je fais intervenir une macro dont voici la partie pour le critère '1':
Application.ScreenUpdating = False
Sheets('EQ').Select
Range('B4:J607').Select
Selection.ClearContents
Range('B1:J1').Select
Sheets('AFFSS').Select
Range('B4').Select
Selection.AutoFilter Field:=6, Criteria1:='1'
Range('B5:J607').Select
Selection.Copy
Sheets('EQ').Select
Cells(4, 2).Select
ActiveSheet.Paste Destination:=ActiveCell
Range('B4').Select
Application.CutCopyMode = False
Range('B4:J13').Select
Selection.Sort Key1:=Range('J4'), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range('B4:J607').Select
Range('B1:J1').Select
Sheets('AFFSS').Select
Selection.AutoFilter
Range('B1:J1').Select
Sheets('EQ').Select
Range('B1:J1').Select
Application.ScreenUpdating = True
J'ai encodé sur 60 équipes pour les grosses organisations. Il n'y a aucun problème sauf lorsque je n'ai que 11 équipes par exemple et que la dernière équipe encodée (critère 11) a des coureurs placés dans les 11 premiers (10 coureurs par équipe et une ligne vide entre pour la feuille de référence), alors, la macro ne trouve pas le critère '12' dans les résultats et me met une formule de référence non demandée à la place. La feuille AFFSS fait référence à la feuille CROSS (ordre d'arrivée) qui elle-même fait référence à 'ELEVES', feuille d'inscription. La formule en question fait référence à la feuille ELEVES!
J'espère être assez clair mais le programme est relativement complexe.
Je m'arrache les derniers cheveux et je ne comprends pas! Merci de votre aide
Christian

 

[CBernardT]

Bonjour Christian et le forum,

Laisses tes derniers cheveux tranquilles, ils n'y sont pour rien !

Je repris ta macro sans savoir ce que tu veux exactement :

Sheets('EQ').Select
Range('B1:J1').Select
Application.ScreenUpdating = False
With Sheets('EQ')
.Range('B4:J607').ClearContents
With Sheets('AFFSS')
.Range('B4').AutoFilter Field:=6, Criteria1:='1'
.Range('B5:J607').Copy
End With
Sheets('EQ').Range('B4').PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range('B4:J13').Sort Key1:=Range('J4'), Order1:=xlAscending, Header:=xlGuess
End With
Sheets('AFFSS').Range('B4').AutoFilter
Application.ScreenUpdating = True

Si tu peux mettre un fichier zippé de moins de 50Ko cela ferait avancer le chimilblick !

Cordialement

Bernard

 

[Christian]

OK, je reprends tout à zéro mais tout à l'heure. Je dois m'absenter absolument. A+

 

[Christian]

Impossible de zipper à moins de 257 Ko! Ou alors je dois enlever trop de pages et plus moyen de travailler dessus! Idée? A bientôt et merci !
Christian