Discussion :

[Un Internaute]

Bonjour le forum,
Tout d'abord mes meilleurs vœux pour 2016 et surtout une bonne santé à tous.

J'ai cette macro dans ThisWorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets(1).Select
Dim Sh As Worksheet
  Application.ScreenUpdating = False
  For Each Sh In ThisWorkbook.Worksheets
    Sh.Select
    Tri
    Range("A1").Select
  Next Sh
  Application.ScreenUpdating = True
End Sub

Et un dans un module Tri:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
Sub Tri()
Dim J As Long, LastRow As Long
 
  Application.ScreenUpdating = False
  LastRow = Range("A" & Rows.Count).End(xlUp).Row
 
  Range("A3:D" & LastRow).Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("A3"), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase _
        :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
 
  With Rows("3:" & LastRow)
    .RowHeight = 50
    .AutoFit
  End With
 
  For J = 3 To LastRow
    If Rows(J).RowHeight <= 15.75 Then Rows(J).RowHeight = 20
  Next J
 Application.Goto Range("A1"), Scroll:=True
Application.EnableEvents = False
End Sub

Jai 6 feuilles dans le classeur
Lorsque j'ajoute dans plusieurs feuilles un nom il vient se mettre au bon endroit et bien par ordre alphabétique à l'enregistrement.
Mais si je m'aperçois que j'ai fait une erreur et que je veux supprimer un de ces noms ça pose problème. Il faut faire Suppr plusieurs fois et plusieurs fois enregistrer avant que ça se fasse correctement et encore....

Ensuite dans ThisWorkbook j'ai mis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets(1).Select

Pour que l'enregistrement se fasse sur la première feuille.
Là aussi problème.

Quelqu'un voit-il ou j'ai loupé quelque chose?
1 – Suppression d'un nom
2 – Enregistrement sur la 1ère feuille
Merci d'avance pou vos retours
Bien cordialement

[Marc-L]

Bonjour,

où est donc le code en question ?

Sinon les méthodes Find et Delete sont appropriées …


______________________________________________________________________________________________________
Je suis Paris, Charlie, …

[Un Internaute]

Bonjour Marc-L , Bonjour à tous,

Voilà ça fonctionne:

Dans ThisWorkbook:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Sh As Worksheet
  Application.ScreenUpdating = False
  For Each Sh In ThisWorkbook.Worksheets
    Sh.Select
    Tri
    Range("A1").Select
  Next Sh
  Sheets(1).Select
  Application.ScreenUpdating = True
End Sub

Dans module tri:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
Sub Tri()
Dim J As Long, LastRow As Long
 
  Application.ScreenUpdating = False
  LastRow = Range("A" & Rows.Count).End(xlUp).Row
 
  Range("A3:D" & LastRow).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlNo, _
                               MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
 
 
  With Rows("3:" & LastRow)
    .RowHeight = 50
    .AutoFit
  End With
 
  For J = 3 To LastRow
    If Rows(J).RowHeight <= 15.75 Then Rows(J).RowHeight = 20
  Next J
 Application.Goto Range("A1"), Scroll:=True
Application.EnableEvents = True
End Sub

Bonne fin de WE
Bien cordialement