XL 2013 Modification macro (AdvancedFilter)

  • Initiateur de la discussion Initiateur de la discussion ksimat
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

ksimat

XLDnaute Junior
Bonsoir,
J'ai une macro qui me copie des données depuis les feuilles "base" et "Bilan" vers la feuille "Admis". Pour éviter les vides qui se placent en haut de la colonne G avec le tri descendant, je voudrais donc modifier une partie du code pour déplacer tri décroissant de [G10] vers [H10] avec ordre croissant.
Si je change
[A9].CurrentRegion.Sort Key1:=[G10], Header:=xlYes, Order1:=xlDescending
en
[A9].CurrentRegion.Sort Key1:=[H10], Header:=xlYes, Order1:=xlAscending

l'en-tête est déplacée en bas de tableau ce qui est bizarre. Je ne parviens pas comprendre ce qui cloche. En vous remerciant d'avance, je vous mets le code en sollicitant votre aide.
Si par ailleurs quelqu'un trouve qu'il est possible de garder le champ de tri en G tout en renvoyant les vides en bas de tableau, ce serait excellent. Voici mon code:

Private Sub Worksheet_Activate()
With Sheets("Admis").Range("B10:I109")
Application.CutCopyMode = False
.ClearContents
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Application.DisplayFullScreen = False
Sheets("Base").[A1:AA200].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[T1:T3], CopyToRange:=[B9:J9]
[A9].CurrentRegion.Sort Key1:=[G10], Header:=xlYes, Order1:=xlDescending
Sheets("Bilan").Range("R10:Y20").Copy
With Sheets("Admis").Range("B" & Rows.Count).End(xlUp).Offset(3, 0)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
Application.DisplayFullScreen = True
End With
End Sub

Merci
Ksimat
 
Bonsoir le fil, le forum

@ksimat
Voici quelques modifications de ton code
VB:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
With Sheets("Admis").[B10:I109]
.ClearContents: .Borders.LineStyle = xlNone
End With
Sheets("Base").[A1:AA200].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[T1:T3], CopyToRange:=[B9:J9]
[B9].CurrentRegion.Sort Key1:=[G10], Header:=1, Order1:=1
Sheets("Bilan").[R10:Y20].Copy
With Sheets("Admis").Range("B" & Rows.Count).End(xlUp).Offset(3, 0): .PasteSpecial 7: End With
Application.Goto [A9], -1
Application.CutCopyMode = False
End Sub

Private Sub Worksheet_Deactivate()
Application.DisplayFullScreen = False
End Sub
 
Bonsoir Staple1600, le forum,
Merci de ton aide. J'ai appliqué les modifications du code mais mon problème reste entier. Je te dois donc quelques explications. En reléguant les cellules vides de la colonne G en bas de tableau je voudrais garder l'ordre c'est à dire le 1er en tête, suivi du 2ème, du 3ème, etc et les vides en fin de liste. Je suppose que cela ne soit pas possible avec le tri numérique décroissant en colonne G. Mais si cela est réalisable en colonne H de droite, ce serait parfait. Pour cela j'ai changé:
[A9].CurrentRegion.Sort Key1:=[G10], Header:=xlYes, Order1:=xlDescending
en
[A9].CurrentRegion.Sort Key1:=[H10], Header:=xlYes, Order1:=xlAscending
Mais comme je l'ai dit dans mon premier post, l'en-tête est remis en bas de page.
Merci
Ksimat
 
Re
C'est exactement ce que je veux éviter. Le plus petit nombre 3,65 doit aller en bas.
Sur mon fichier test si je deplace le tri en colonne H, j'obtiens ce que je veux mais sur dans mon vrai classeur l'en-tête se retrouvera en bas. Le problème doit être lié à mon classeur original.
Pourtant ce qui est bizarre c'est que dans ce classeur (le vrai) ça a toujours fonctionné avec [A9].CurrentRegion jusqu'à ce que je décide de virer les cellules vides en bas de liste. Avez-vous une idée?
Merci
Ksimat
 
Re

Et comme cela?
VB:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
With Sheets("Admis").[B10:I109]
.ClearContents: .Borders.LineStyle = xlNone
End With
Sheets("Base").[A1:AA200].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[T1:T3], CopyToRange:=[B9:J9]
[B9].CurrentRegion.Sort Key1:=[G10], Header:=1, Order1:=xlDescending
Sheets("Bilan").[R10:Y20].Copy
With Sheets("Admis").Range("B" & Rows.Count).End(xlUp).Offset(3, 0): .PasteSpecial 7: End With
Application.Goto [A9], -1
Application.CutCopyMode = False
End Sub

Private Sub Worksheet_Deactivate()
Application.DisplayFullScreen = False
End Sub
 
Re

@ksimat
Avec ton fichier exemple, sur mon PC, les entêtes ne bougent pas et le tri se fait sur la colonne A.
VB:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
With Sheets("Admis").[B10:I109]
.ClearContents: .Borders.LineStyle = xlNone
End With
Sheets("Base").[A1:AA200].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[T1:T3], CopyToRange:=[B9:J9]
[B9].CurrentRegion.Sort Key1:=[H10], Header:=1, Order1:=xlDescending
Sheets("Bilan").[R10:Y20].Copy
With Sheets("Admis").Range("B" & Rows.Count).End(xlUp).Offset(3, 0): .PasteSpecial 7: End With
Application.Goto [A9], -1
Application.CutCopyMode = False
End Sub

Private Sub Worksheet_Deactivate()
Application.DisplayFullScreen = False
End Sub
 
Re
@Staple, vous avez vu juste. Je parviens même à avoir le tri ascendant en colonne H avec les vides en bas et les titre en haut. Le problème est imputable à mon fichier officiel où les titres sont renvoyés en bas . Je vais m'en contenter en laissant le vides en haut de tableau.
Autre chose, comment remplacer le PasteSpecial 7 pour conserver le format d'origine de la copie (les cadres et les valeurs des cellules)?
Merci infiniment, votre aide m'a été très précieuse.
Ksimat
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
912
Réponses
1
Affichages
1 K
Réponses
1
Affichages
602
Compte Supprimé 979
C
Réponses
2
Affichages
736
Retour