Macro suppression lignes vides
Bonjour,
je souhaiterais mettre en place une macro qui à l'enregistrement ou à la fermeture du fichier supprime toutes les lignes qui ont une cellule vide en A. La suppression de la ligne et du quadrillage car cela m'alourdit les fichiers.
En fait, j'ai une 100aine d'équipe et un fichier par semaine. Pour chaque fichier préparé à l'avance j'ai 500 lignes mais en fonction des semaines et des équipes je n'utilise parfois qu'une 50aine de lignes.
Dans le fichier j'ai plusieurs macros mais toutes ne fonctionnent pas correctement sur la pièce jointe car j'ai supprimé des feuilles n'ayant pas de rapport avec ma demande.
Mon fichier est également protégé par un mot de passe qui est "motdepasse".
Pour finir l'explication, toutes les données de la colonne A à la colonne J sont copiées chaque semaine sur ce fichier car extraite d'un logiciel sous un format TXT.
Je créé donc tous les fichiers pour toutes les équipes pour chaque semaine grâce à une macro du fichier et toutes sous le même format (fichier institutionnalisé).
Merci de bien vouloir m'aider à corriger ma macro de suppression de lignes qui ne fonctionne pas bien sans que j'arrive à trouver l'erreur (actuellement elle est en application avant l'enregistrement) et le code est :
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lig As Long
With Sheets("Séjours à coder")
If .Range("A3") = "" Then Exit Sub
lig = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(lig + 1, 1), .Cells(lig + 1, 23).End(xlDown)).Delete Shift:=xlUp
On Error Resume Next
With .Range("A4:A" & lig).SpecialCells(xlCellTypeBlanks).EntireRow
.Delete Shift:=xlUp
End With
End With
End Sub
Bonjour
Modifies cette procédure
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lig As Long
With Sheets("Séjours à coder")
If .Range("A3") = "" Then Exit Sub
Application.EnableEvents = False
.Unprotect Password:="motdepasse"
lig = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(lig + 1, 1), .Cells(lig + 1, 23).End(xlDown)).Delete Shift:=xlUp
On Error Resume Next
With .Range("A4:A" & lig).SpecialCells(xlCellTypeBlanks).EntireRow
.Delete Shift:=xlUp
End With
.Protect Password:="motdepasse", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowSorting:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFiltering:=True
Application.EnableEvents = True
End With
End Sub
je te remercie, ça à l'air de fonctionner impec...
Une autre question en rapport avec ce fichier : certains collègues qui n'ont aucune formation en excel (d'où les mots de passe pour protéger) ne font pas la mise en page demandée (quadrillage sur les premières cellules).
Pour moi c'est inutile mais les chefs ont décidé qu'il devait y être.
Comment mettre en place une macro pour que si la cellule en A est remplie (à partir de A3) alors le quadrillage est fait comme sur le fichier joint. Cette macro peut être combinée à la précédente. Si A vide, suppression du quadrillage, si A non vide mise en place du quadrillage de A à J.
Encore merci
Bonjour
Modifies la macro
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lig As Long
With Sheets("Séjours à coder")
If .Range("A3") = "" Then Exit Sub
Application.EnableEvents = False
.Unprotect Password:="motdepasse"
lig = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(lig + 1, 1), .Cells(lig + 1, 23).End(xlDown)).Delete Shift:=xlUp
On Error Resume Next
With .Range("A4:A" & lig).SpecialCells(xlCellTypeBlanks).EntireRow
.Delete Shift:=xlUp
End With
.Range("A3:W" & .Range("A" & Rows.Count).End(xlUp).Row).Borders.Weight = xlThin
.Protect Password:="motdepasse", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowSorting:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFiltering:=True
Application.EnableEvents = True
End With
End Sub
merci c'est super, mais je voudrais juste entre J et K un trait épais, ainsi qu'entre A2 et A3
Encore merci pour ton aide
Bonjour
Je t'ai fait aussi le trait épais sur les autres colonnes comme dans l'original
Macro à remplacer
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lig As Long
With Sheets("Séjours à coder")
If .Range("A3") = "" Then Exit Sub
Application.EnableEvents = False
.Unprotect Password:="motdepasse"
lig = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(lig + 1, 1), .Cells(lig + 1, 23).End(xlDown)).Delete Shift:=xlUp
On Error Resume Next
With .Range("A4:A" & lig).SpecialCells(xlCellTypeBlanks).EntireRow
.Delete Shift:=xlUp
End With
On Error GoTo 0
lig = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A3:W" & lig).Borders.Weight = xlThin
.Range("A3:W3").Borders(xlEdgeTop).Weight = xlThick
.Range("J3:J" & lig & ",N3:N" & lig & ",N3:N" & lig & ",S3:S" & lig & ",V3:V" & lig & ",W3:W" & lig).Borders(xlEdgeRight).Weight = xlThick
.Protect Password:="motdepasse", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowSorting:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFiltering:=True
Application.EnableEvents = True
End With
End Sub
encore merci pour ton aide.
J'ai un message d'erreur dans la macro :
"Erreur d'exécution '1004' :
impossible définir la propriété Weight de la classe Borders"
.Range("A3:W" & lig).Borders.Weight = xlThin
Est-ce que le fait d'être sous 2010 peut être la cause de cette erreur?
Bonjour
matt31 a écrit :.Range("A3:W" & lig).Borders.Weight = xlThin
Je viens d'essayer (avec 2003) pas de soucis
C'est la même chose que dans la macro précédente
.Range("A3:W" & .Range("A" & Rows.Count).End(xlUp).Row).Borders.Weight = xlThin
J'ai juste remplacer la définition .Range("A" & Rows.Count).End(xlUp).Row par Lig qui est égal à lig = .Range("A" & Rows.Count).End(xlUp).Row
Pourquoi cela fonctionne dans un sens et pas dans l'autre ?
Vérifies bien ton code
Si la macro est planté il y a de fortes chances que les évènements ne soient plus interceptés
il faut lancer manuellement une macro du style
Sub Ret
Application.EnableEvents = True
End Sub
j'ai testé sur un autre fichier, tout fonctionne normalement et correctement.
Où mets-tu cette macro ?
Sub Ret
Application.EnableEvents = True
End Sub
Workbook, feuille ou module?
la macro plante à la 2° ouverture du fichier.
La 1° fois elle trace correctement les lignes. La 2° fois par contre, que je la mette avant l'enregistrement ou avant la fermeture, elle plante à l'endroit indiqué.
Bonsoir
Pour la macro ret peu importe l'endroit
C'est une macro à lancer manuellement au cas ou tu t'aperçois que il n'y a plus d'interception des d'évènements (suite à un plantage de la macro )
Pour le plantage je ne sais point
Je viens , d'ouvrir, de sauvegarder et fermer, plusieurs fois de suite et pas de plantage
Essayes de remplacer la ligne incriminée par celle-ci
Je n'y crois pas mais bon on teste
.Range("A3:W" & .Range("A" & Rows.Count).End(xlUp).Row).Borders.Weight = xlThin
C'est exactement la même chose.
la macro fonctionne la 1° fois et ensuite à la 2° fois j'ai le même message d'erreur.
Je confirme par contre que sous 2003 il n'y a pas de problème.
Bonsoir
Moi je n'ai que 2003
Si quelqu'un veut bien tester sous 2007 afin de trouver l'incompatibilité et le remède , d'avance merci