Macro avec 7 opérations
(j'ai reformulé mon annonce)
Bonjour à tous,
Je souhaite créer une macro (ou 2 Macro ?), qui permet de faire les 7 manipulations suivantes :
Sur la Feuille 1:
1- Supprimer les colonnes C, D ensuite I, J, K
2- Supprimer les lignes 5, 6, 7
3- Mettre ligne A10:L10 en couleur gris clair
4- Mettre un filtre à la cellule I10, et filtrer I10 par un ordre décroissant
Sur la Feuille 2:
1- Supprimer les colonnes C, D
2- Mettre A6:H6 en couleur gris clair
3- Mettre un filtre à la cellule A6
Je souhaite, si c’est possible, pouvoir exécuter la Macro sur n’importe quel fichier que j'ouvre, et même si les noms des onglets changent svp.
J’ai essayé en plusieurs reprises à créer celle-ci à l’aide de ‘’l’enregistrement Macro’’, mais ma Macro plante durant l’exécution pour une raison inconnue.
Si vous me permettez, je vous transmets le fichier Excel.
En vous souhaitant une bonne réception.
Cher internaute, je vous serai beaucoup reconnaissant, cette Macro m’aidera beaucoup, je vous remercie à l'avance pour votre précieux aide.
Salut las-dias,
voici une première solution dont j'espère les critiques (toujours constructives
A ce stade, je ne vois qu'une possibilité :
- copier cette macro dans CHACUN de tes classeurs dans le module 'ThisWorkBook'
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Left(ActiveSheet.Name, 8) = "Training" Then Application.Run ("PERSONAL.XLSB!Training")
If Left(ActiveSheet.Name, 10) = "Attendance" Then Application.Run ("PERSONAL.XLSB!Attendance")
End If
'
End Sub- copier les deux macros suivantes dans le module de ton fichier personnel 'PERSONAL.XLSB'
Public Sub Training()
'
Application.ScreenUpdating = False
'
For x = 1 To 5
iCol = Choose(x, 13, 12, 11, 4, 3)
Columns(iCol).Delete shift:=xlToLeft
Next
Rows("5:7").Delete shift:=xlUp
Range("A10:L10").Interior.Color = RGB(215, 215, 215)
Range("A10:L10").BorderAround LineStyle:=xlContinuous
iRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A11:L" & iRow).Sort key1:=Range("I11"), order1:=xlDescending, Orientation:=xlTopToBottom
'
Application.ScreenUpdating = True
'
End Sub
'
Public Sub Attendance()
'
Application.ScreenUpdating = False
'
For x = 1 To 2
iCol = Choose(x, 4, 3)
Columns(iCol).Delete shift:=xlToLeft
Next
Range("A6:h6").Interior.Color = RGB(215, 215, 215)
Range("A6:h6").BorderAround LineStyle:=xlContinuous
'
Application.ScreenUpdating = True
'
End SubMaintenant, il faudrait bien se mettre d'accord :
- vu que le traitement ne peut se faire qu'une fois par feuille, je trouve inutile de créer un bouton : un simple double-clic en [A1] suffit, me semble-t-il...
Je veux bien prévoir quantité de trucs mais il faudrait peut-être nous donner des critères précis et calculables pour savoir quelle macro doit être mise en œuvre en fonction de la feuille active!!!!!
Ici, cela ne fonctionnera QUE si le nom des feuilles commence par TRAINING ou ATTENDANCE.
- Peux-tu préciser quels tris tu comptes opérer sur tes données?
° uniquement sur 'Remaining' en feuille TRAINING ?
° quel filtre sur quelle colonne en feuille ATTENDANCE ?
Teste toujours ceci et on verra la suite à donner...
A+
Bonjour Curulis57,
Je vous remercie pour le temps que vous avez consacré à cet exercice
Suite à vos remarque, j'ai reformulé les points suivants de mon annonce :
En effet, je souhaite 1 macro (ou 2 Macro ?), qui permet de:
Sur la Feuille 1:
3- Mettre la ligne A10:L10 en couleur gris clair
4- Mettre un filtre à la cellule I10, et filtrer I10 par un ordre décroissant
Sur la Feuille 2:
2- Mettre A6:H6 en couleur gris clair
3- Mettre un filtre à la cellule A6
Par contre, Est ce que c'est possible d'exécuter la Macro même si les noms des onglets changent svp ? car je travaille sur différents fichiers avec différents noms d'onglets.
Bonjour las-dias,
Si les noms d'onglets changent mais que la structure est la même (emplacement et type des données),
tu peux accéder aux feuilles par leur numéro d'index ; exemple : Worksheets(5) est toujours la 5ème
feuille du classeur, quelque soit son nom ; bien sûr, il y aura une erreur si pas de 5ème feuille.
Ce que j'ai écrit est juste une piste, car avec plusieurs fichiers différents, ce serait vraiment
une grosse coïncidence que « ça colle » parfaitement dans tous les cas !
curulis57 aura peut-être une meilleure idée ou une solution miracle ?
Cordialement
Bonsoir Dhany,
Je vous remercie pour votre réponse.
OUI, les noms d'onglets changent mais la structure reste toujours est la même, en conséquence, les manipulations colleront avec tous les fichiers sur lesquels je travaille !
Comme je suis nul en VBA, je souhaite savoir si vous pouvez m'éclairer ou m'illustrer votre réponse au sujet du changement du nom de l'onglet "Worksheets.." en VBA si c'est possible SVP ?
Ce que j'ai écrit précédemment était en VBA.
Exemple : pour sélectionner la feuille 5, puis mettre le nombre 24 en cellule D8 :
Worksheets(5).Select: [D8] = 24Pour mettre le nombre 24 dans la cellule D8 de la feuille 5 sans la sélectionner :
Worksheets(5).[D8] = 24Autre exemple, pour faire plusieurs choses différentes pour la feuille 5 :
Sub Essai()
With Worksheets(5)
.[D8] = 24 ' mettre le nombre 24 dans la cellule D8 de la feuille 5
MsgBox .[D8] ' afficher le contenu de la cellule D8 de la feuille 5
End With
End SubAttention : ne pas oublier le point ( . ) devant [D8] car c'est cela qui
le fait dépendre de ce qui est indiqué par With : Worksheets(5)
Si tu veux changer de feuille, mets juste un autre n° d'index :
With Worksheets(3) ' avec la 3ème feuille du classeur
Pour changer le nom d'une feuille :
a) si cette feuille est la feuille active : ActiveSheet.Name = "Nom feuille"
b) pour une feuille bien précise, même si elle n'est pas active :
Worksheets(3).Name = "Nom feuille" ' nom pour la 3ème feuille
Bonjour tous
Voici une nouvelle proposition
sans critique, peut être plus "vrais cracks" sans aucune prétentioncurulis57 a écrit :voici une première solution dont j'espère les critiques (toujours constructives ) des vrais cracks!
Ce code est à mettre sur un nouveau classeur qui se charge de lire "les fichiers à traiter", de faire les transformations
Tout cela en 2 étapes
1) par la procédure TraiterClasseurs
1.1) Sélection des fichiers à traiter,
1.2) Sélection des onglets 1 et 2 à traiter
2) par la procédure TransformerClasseurs => Transformation
Public tabClasseur()
Public nbrClasseurs
Public wsTransf As Object
Public wsActive As Object
Function FiltreRange(bloc As Range, codClasseur)
Dim tabTemp()
Dim cptTemp, colTemp
Dim tabFilt()
Dim nbrFilt
tabTemp = bloc
nbrFilt = 0
ReDim tabFilt(1 To 3, 1 To 1)
For cptTemp = 1 To UBound(tabTemp, 1)
If tabTemp(cptTemp, 1) = codClasseur Then
If Not IsEmpty(tabTemp(cptTemp, 3)) Then
nbrFilt = nbrFilt + 1
ReDim Preserve tabFilt(1 To 3, 1 To nbrFilt)
For colTemp = 1 To 3
tabFilt(colTemp, nbrFilt) = tabTemp(cptTemp, colTemp)
Next
End If
End If
Next
If nbrFilt > 1 Then
FiltreRange = WorksheetFunction.Transpose(tabFilt)
Else
FiltreRange = False
End If
End Function
Sub TransformerClasseurs()
Dim cptClasseurs
Dim tabOnglets
Dim cptOnglets
Dim enCours
Set wsTransf = Workbooks(ActiveWorkbook.Name)
tabClasseur = Range(Cells(2, 1), Cells(LigneFin - 1, 2))
For cptClasseurs = 1 To UBound(tabClasseur, 1)
tabOnglets = FiltreRange(Range(Cells(2, 4), Cells(LigneFin(4), 6)), tabClasseur(cptClasseurs, 2))
enCours = tabClasseur(cptClasseurs, 1)
If Not (VarType(tabOnglets) = vbBoolean) Then
enCours = enCours & " " & UBound(tabOnglets, 1)
MsgBox enCours
Workbooks.Open tabClasseur(cptClasseurs, 1)
Set wsActive = Workbooks(ActiveWorkbook.Name)
With wsActive
'------------------------------------------------------------------------------------------------
'Sur la Feuille 1:
'1- Supprimer les colonnes C, D ensuite I, J, K
'2- Supprimer les lignes 5, 6, 7
'3- Mettre ligne A10:L10 en couleur gris clair
'4- Mettre un filtre à la cellule I10, et filtrer I10 par un ordre décroissant
'
'Sur la Feuille 2:
'1- Supprimer les colonnes C, D
'2- Mettre A6:H6 en couleur gris clair
'3- Mettre un filtre à la cellule A6
'------------------------------------------------------------------------------------------------
For cptOnglets = 1 To UBound(tabOnglets, 1)
Select Case tabOnglets(cptOnglets, 3)
Case 1
With .Sheets(tabOnglets(cptOnglets, 2))
Range(.Cells(1, 9), .Cells(1, 11)).EntireColumn.Delete
Range(.Cells(1, 3), .Cells(1, 4)).EntireColumn.Delete
Range(.Cells(5, 1), .Cells(7, 1)).EntireRow.Delete
With Range(.Cells(10, 1), .Cells(10, 12))
.Interior.Color = 14540253
.AutoFilter
End With
.AutoFilter.Sort.SortFields.Clear
ligFin = .Cells(Rows.Count, 1).End(xlUp).Row
.AutoFilter.Sort.SortFields.Add _
Key:=Range(.Cells(11, 9), .Cells(ligFin, 9)), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.AutoFilter.Sort.Header = xlYes
.AutoFilter.Sort.Apply
End With
Case 2
With .Sheets(tabOnglets(cptOnglets, 2))
Range(.Cells(1, 3), .Cells(1, 4)).EntireColumn.Delete
Range(.Cells(6, 1), .Cells(6, 8)).Interior.Color = 14540253
Range(.Cells(6, 1), .Cells(6, 8)).AutoFilter
End With
End Select
Next
.SaveAs "OK " & tabClasseur(cptClasseurs, 1)
.Close False
End With
Set wsActive = Nothing
Else
MsgBox enCours & " Aucun"
End If
Next
Set wsTransf = Nothing
End Sub
Sub TraiterClasseurs()
Dim mesClasseurs
Dim lotClasseurs As Boolean
Dim cptClasseurs
Application.ScreenUpdating = False
Set wsTransf = Workbooks(ActiveWorkbook.Name)
Range(Cells(2, 1), Cells(LigneFin, 2)).ClearContents
Range(Cells(2, 4), Cells(LigneFin(4), 6)).ClearContents
nbrClasseurs = 0
mesClasseurs = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*", MultiSelect:=True)
If VarType(mesClasseurs) = vbBoolean Then
MsgBox "Aucun fichier à Traiter"
Else
lotClasseurs = VarType(mesClasseurs) > vbArray
If lotClasseurs Then
For cptClasseurs = 1 To UBound(mesClasseurs, 1)
TraiterOnglets mesClasseurs(cptClasseurs), cptClasseurs
Next
Else
TraiterOnglets mesClasseurs, cptClasseurs
End If
End If
Set wsTransf = Nothing
Application.ScreenUpdating = True
End Sub
Sub TraiterOnglets(nomClasseur, numClasseur)
Dim ligFin
Dim cptOnglet
Dim nomCourt
Workbooks.Open nomClasseur
Set wsActive = Workbooks(ActiveWorkbook.Name)
With wsActive
ligFin = LigneFin
nomCourt = Split(nomClasseur, "\")
wsTransf.Sheets(1).Cells(ligFin, 1) = nomCourt(UBound(nomCourt, 1))
wsTransf.Sheets(1).Cells(ligFin, 2) = numClasseur
For cptOnglet = 1 To .Sheets.Count
ligFin = LigneFin(4)
wsTransf.Sheets(1).Cells(ligFin, 4) = numClasseur
wsTransf.Sheets(1).Cells(ligFin, 5) = .Sheets(cptOnglet).Name
ligFin = ligFin + 1
Next
.Close False
End With
Set wsActive = Nothing
End Sub
Function LigneFin(Optional colRef = 1)
LigneFin = wsTransf.Sheets(1).Cells(Rows.Count, colRef).End(xlUp).Row + 1
End Function
Bonjour à tous,
Je vous remercie pour vos réponses intéressantes.
J'ai fini ma Macro, je me situe à la dernière étape dont j'aurai encore besoin de votre aide svp !
BUT: Je souhaite afficher ma Macro dans TOUS les fichiers excel que j'ouvre.
J'ai consulté quelques forums qui ont déjà traité ce sujet, certes comme je suis assez nul en excel j'ai pas réussi à faire ceci. Pourriez-vous m'expliquer étape par étape svp ?
Je vous remercie d'avcance.
Bonjour (..)
tu as réussi à faire quoi ? Que veux tu que l'on t'explique ? Il n'y a pas de fichier, de code... ?las-dias a écrit :J'ai consulté quelques forums qui ont déjà traité ce sujet, certes comme je suis assez nul en excel j'ai pas réussi à faire ceci. Pourriez-vous m'expliquer étape par étape svp ?
Bonjour las-dias,
Tu a écrit :BUT: Je souhaite afficher ma Macro dans TOUS les fichiers excel que j'ouvre.
Pour qu'une macro puisse être utilisée de façon générale dans plusieurs classeurs différents,
il faut la placer dans un classeur spécial nommé "Personal.xlsb" ; voir ce lien :
Cordialement
Salut l'équipe,
je serais très curieux de voir cette macro!
Comme nous n'avions pas beaucoup de précisions quant à l'organisation de tes fichiers (nombre de feuilles par classeur, structure, ordre...), je ne vois pas comment écrire une macro générale!
As-tu essayé la bombe atomique de NCC, très impressionnante ?
Tu ne nous dit pas non plus comment tu comptes déclencher cette macro!
Bref, pour moi (à mon petit niveau), c'est encore fort nébuleux... mais je ne demande qu'à me tromper, bien sûr!
A+
Bonjour curulis57,
Dans son message d'hier à 00:53,
las-dias a écrit :OUI, les noms d'onglets changent mais la structure reste toujours la même, en conséquence,
les manipulations colleront avec tous les fichiers sur lesquels je travaille !
Je pense que c'est grâce à cela que le demandeur peut écrire une macro générale.
Cordialement
Salut dhany,
oui, j'ai bien lu aussi, évidemment!
Mais, ce serait vraiment miraculeux que tout se goupille aussi parfaitement!
Je suis un peu comme St-Thomas...
A+
Bonjour (..)
@curulis57
curulis57 a écrit :As-tu essayé la bombe atomique de NCC, très impressionnante ?
Ce n'est pas une bombe atomique c'est un peu de VBA avec un brin de
que j'ai tenté d'curulis57 a écrit :Comme nous n'avions pas beaucoup de précisions quant à l'organisation de tes fichiers (nombre de feuilles par classeur, structure, ordre...),
en me disant quecurulis57 a écrit :écrire une macro générale!
cependant comme toidhany a écrit :Dans son message d'hier à 00:53,las-dias a écrit:OUI, les noms d'onglets changent mais la structure reste toujours la même, en conséquence,les manipulations colleront avec tous les fichiers sur lesquels je travaille !Je pense que c'est grâce à cela que le demandeur peut écrire une macro générale.
j'aimerais bien savoir quelle est la solution finalement adoptéecurulis57 a écrit :oui, j'ai bien lu aussi, évidemment!Mais, ce serait vraiment miraculeux que tout se goupille aussi parfaitement!Je suis un peu comme St-Thomas...
Sub Macro1()
'
' Macro1 Macro
'
'
[u] Range("A10:L15").Select
[/u] ExecuteExcel4Macro "PATTERNS(1,0,65535,TRUE,2,3,0,0)"
End Sub
Bonjour, dans la petite macro ci-dessus, le VBA sélection la plage A10:L5 (de la cellule A10 à L15).
Je souhaite dire à la Macro, de sélectionner de A10 à L10, puis ensuite d'aller jusqu'à la dernière ligne non vide de la plage.
Quelles sont les modifications qu'il faut apporter SVP ? je vous remercie encore une fois votre aide précieux :rol
Sub Macro1()
'
' Macro1 Macro
'
'
[u] Range("A10:L15").Select
[/u] ExecuteExcel4Macro "PATTERNS(1,0,65535,TRUE,2,3,0,0)"
End Sub
Bonjour, dans la petite macro ci-dessus, le VBA sélection la plage A10:L5 (de la cellule A10 à L15).
Je souhaite dire à la Macro, de sélectionner de A10 à L10, puis ensuite d'aller jusqu'à la dernière ligne non vide de la plage.
Quelles sont les modifications qu'il faut apporter SVP ? je vous remercie encore une fois votre aide précieux :roll
Salut las-dias,
pas sûr d'avoir compris...
'
iRow = Range("L" & Rows.Count).End(xlUp).Row
Range("A10:L" & iRow).Select
'A+
D'accord, je vous remercie pour votre réponse.
Certes, comme je suis nul en VBA, je souhaite savoir ou faut-il mettre votre VBA dans ma macro SVP ?
Si j'ai compris est ce qu'il faut remplacer :
Range("A10:L15").Select
PAR
'
iRow = Range("L" & Rows.Count).End(xlUp).Row
Range("A10:L" & iRow).Select
'
Et le tour est joué ?
Salut las-dias,
en théorie et si j'ai bien compris le but recherché : OUI.
A+
Bonjour ( ..)
@plas-dias
Certes tu es nul en macro et en VBA, mais pas que... tu peux nous expliquer ce que tu veux vraiment ?