XL 2019 Modifier une macro pour la feuille active

berru76

XLDnaute Occasionnel
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
 

jmfmarques

XLDnaute Accro
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

XLDnaute Barbatruc
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)
VB:
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

XLDnaute Occasionnel
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
 

berru76

XLDnaute Occasionnel
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
 

Staple1600

XLDnaute Barbatruc
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
VB:
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! ;)
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 786
Membres
101 817
dernier inscrit
carvajal