XL 2019 Modifier une macro pour la feuille active

[berru76]

Bonjour
au lieu de faire la même macro pour chaque feuille je voudrais faire une macro qui ne prendrai que la feuille active
j'aimerai un modèle car il y a 5 macros par feuille et 50 feuille
Exemple cette macro
Merci
Sub RazscoresF96()
'
' RazscoresF96 Macro
'

'
Range("AI4:AI51,AM4:AM51,AQ4:AQ51,AU4:AU51,AY4:AY51,BC4:BC51,BG4:BG51,BK4:BK51" _
).Select
Range("BK4").Activate
Selection.ClearContents
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A3").Select
End Sub

 

[kingfadhel]

Bonsoir le fil,

Sub RazscoresF96()
With ActiveSheet
.Range("AI4:AI51,AM4:AM51,AQ4:AQ51,AU4:AU51,AY4:AY51,BC4:BC51,BG4:BG51,BK4:BK51" _
).Select
Selection.ClearContents
.Range("A3").Select
End With
End Sub

 

[jmfmarques]

Bonjour

au lieu de faire la même macro pour chaque feuille je voudrais faire une macro qui ne prendrai que la feuille active

Je ne comprends pas la question, dès lors que la non spécification d'une feuille a pour effet que les instructions de la macro concernent précisément la feuille active.
Il n'est par contre pas improbable que ton besoin, autre, ait mal été exposé et ne peux que t'inviter, le cas échéant, à l'exposer à nouveau de manière précise et détaillée.

 

[Staple1600]

Bonjour le fil, berru76, kingfadhel, jmfmarques

Mon interprétation de la question
Une macro paramétrée
(avec deux exemples d'utilisation)
(A tester bien évidemment sur une copie du fichier original)

Sub test_1()
Raz_Scores Feuil1 'ici on traite la feuille qui a pour codename: Feuil1
Raz_Scores Sheets("Feuil2") 'ici on traite la feuille nommée Feuil2
End Sub
Sub test_2() 'ici on traite toutes les feuilles du classeur actif
Dim ws As Worksheet
For Each ws In Worksheets
Raz_Scores ws
Next
End Sub
Private Sub Raz_Scores(Feuille As Worksheet)
Dim i&
For i = 35 To 63 Step 4: Feuille.Cells(4, i).Resize(48) = "": Next
End Sub

 

[berru76]

Bonjour

en final sur les 6 macros 4 fonctionnent directement sur la la feuille active vu que c'est les mêmes cellules
Sur les 2 qui restent
sur une : problème mineur imprime 1 page vide
sur l' autre un classement avec tri mais chaque feuille avec un nombre de joueurs différents
peut on ajouter : que les cellules actives pour la feuille a imprimer/pour supprimer la feuille blanche
peut on ajouter : que les cellules actives pour la feuille avec tri/car si 40 joueurs résultats faux cela prend en compte les cellules vides
ou doit on faire une macro pour chaque feuille
Merci a vous

la 1/

Sub Imprimerlesresultats()
'
' Imprimerlesresultats Macro
'

'
ActiveSheet.Unprotect
Range("BS2:BV99").Select
Selection.PrintOut Copies:=1, Collate:=True
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("A3").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub

La 2 feuille 96 joueurs /

Sub Triclassement()
'
' Triclassement Macro
'

'
ActiveSheet.Unprotect
Range("AB3:AD99").Select
Selection.Copy
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 62
ActiveWindow.ScrollColumn = 63
ActiveWindow.ScrollColumn = 64
ActiveWindow.ScrollColumn = 65
ActiveWindow.ScrollColumn = 66
ActiveWindow.ScrollColumn = 67
ActiveWindow.ScrollColumn = 68
ActiveWindow.ScrollColumn = 69
ActiveWindow.ScrollColumn = 70
ActiveWindow.ScrollColumn = 71
ActiveWindow.ScrollColumn = 70
ActiveWindow.ScrollColumn = 69
ActiveWindow.ScrollColumn = 68
ActiveWindow.ScrollColumn = 67
ActiveWindow.ScrollColumn = 66
ActiveWindow.ScrollColumn = 65
ActiveWindow.ScrollColumn = 64
ActiveWindow.ScrollColumn = 63
ActiveWindow.ScrollColumn = 62
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 57
Range("BO3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("96").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("96").Sort.SortFields.Add2 Key:=Range("BO4:BO99"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("96").Sort.SortFields.Add2 Key:=Range("BP4:BP99"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("96").Sort
.SetRange Range("BO3:BQ99")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A3").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub

 

[Staple1600]

Re

•>berru76
Tu n'as pas testé le code que je t'ai proposé?
(celui du message#5)
C'est un peu fort de café, non ?!
Ça donne vraiment envie d'essayer de t'aider...

 

[berru76]

Testé me donne
sub fonction non défini dans les deux cas sur macro raz scores
oublier de préciser pour cela m'a donné l'occasion de voir que même cellule même suppression sur toute les feuilles
2 autres macro masquer ou afficher des cellules fonctionnent sur toute les feuilles actives de 96 a 40
ne me reste plus que les 2 macros du message 5 a améliorer pour éviter 46 macros supplémentaires
Merci

 

[patricktoulon]

re
en vitesse comme ca

Sub RazscoresF96()
 ActiveSheet.Range("AI4:AI51,AM4:AM51,AQ4:AQ51,AU4:AU51,AY4:AY51,BC4:BC51,BG4:BG51,BK4:BK51").ClearContents
Application.Goto [A3]
End Sub

épicétou'

 

[berru76]

Fonctionne
Une idée pour les deux autres
merci

 

[Staple1600]

Re, Bonjour à toi aussi patricktoulon...

•>berru76
C'est que tu as mal testé alors...
(Généralement, je teste mes codes avant de les poster...)
Tu as copié tout le code VBA présent dans le message#4?

 

[berru76]

je vais réessayer je pense que j'ai séparée la formule
je vous tiens au courant
merci

 

[Staple1600]

Re

Evidemment quand on appelle la macro Raz_Scores
il faut que la feuille spécifiée existe bien dans le classeur
Donc si la feuille à traiter se nomme toto alors on aura

Sub test_3()
Raz_Scores Sheets("toto")
End Sub

 

[berru76]

J'ai retenter je pense que cela vient du fait que la première page est la feuille d'inscription qui dirige vers les feuilles 40 a 96 me dis erreur 9
merci

 

[Staple1600]

Re

Bah teste simplement sur un fichier de test créé pour ce test
(ce que j'ai fait)
Donc copie tout ce code dans un classeur vierge

Sub MaisOuiCaMarche()
Sheets.Add(, Sheets(Sheets.Count)).Name = "TEST"
Sheets("TEST").Range("AI1:BK177") = "abc"
Sheets("TEST").Range("AI1").Select
MsgBox "Lancer le test d'effacement?", vbQuestion + vbOKOnly
Raz_Scores Worksheets("TEST")
End Sub
Private Sub Raz_Scores(Feuille As Worksheet)
Dim i&
For i = 35 To 63 Step 4: Feuille.Cells(4, i).Resize(48) = "": Next
End Sub

On est d'accord?
Cela fonctionne, non!

 

[berru76]

oui merci