Microsoft 365 VBA: trier des cellules

Aloha

XLDnaute Accro
Bonjour,

Dans le fichier en annexe je voudrais trier le bloc bleu pour que les lignes vides disparaissent.

Les lignes vides proviennent de la copie d'un bloc de cellules qui sont liées deux par deux verticalement. L'action de copier lève la liaison de sorte qu'une ligne sur deux est vide.

J'ai essayé de transformer du code enregistré lors du triage du bloc jaune, mais cela ne fonctionne pas.

A préciser qu'après le bloc bleu il y aura une multitude d'autres blocs et j'ai donc besoin d'une solution passe-partout.

Bonne journée
Aloha
 

Pièces jointes

  • Trier bloc bleu.xlsm
    14 KB · Affichages: 11

fanch55

XLDnaute Barbatruc
Aloha à vous,
Essayez de lancer la sub ci-dessous après chaque "copier/coller" concerné
VB:
Sub Tri_Me()
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("A2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 

juvaxe

XLDnaute Occasionnel
Bonjour

Peux-tu expliciter ta demande.

S'il s'agit de faire seulement un tri tu peux très facilement passer par Données/Trier après avoir sélectionner la zone sur laquelle doit porter le tri. C'est immédiat à moins que je n'aie pas tout perçu.

Les lignes vides vont toutes être regroupées à la fin donc plus faciles à supprimer je suppose.

S'il s'agit d'éviter de sélectionner une à une les lignes vides pour les supprimer la solution me semble satisfaisante.

Autre recette : tu peux démarrer l'enregistrement d'une macro avant de faire les manip à la main; une fois l'enregistrement terminé libre à toi de reprendre la macro proposée par Excel pour l'adapter à ton besoin.

Bonne réception
 

Aloha

XLDnaute Accro
Bonjour,

@"fanch55":
Merci pour le code! Il fonctionne comme il faut!

@"juvaxe": il faut absolument faire le tri par VBA: des blocs comme dans le fichier, qui 'étendent en réalité sur un mois entier (avec donc 30 ou 31 lignes vides) il y en a plus de 130 qui sont copiés tous les mois par VBA.

J'ai enregistré l'action, mais j'ai trébuché lorsqu'il fallait remplacer les références fixes comme A4:A65.

Bien à vous
Aloha
 

Aloha

XLDnaute Accro
Bonjour,
Ma prochaine tâche est de copier "Nom2" dans les cellules A10:A15.
Comment faire pour définir cette rangée? Mon problème est que je dois me référer à 2 colonnes différentes: pour A10 c'est la première cellule libre en A, mais pour A15 je dois me baser sur l'une des autres colonnes.
Bonne journée
Aloha
 

Pièces jointes

  • Trier bloc bleu 1.xlsm
    16.7 KB · Affichages: 7

fanch55

XLDnaute Barbatruc
Bonjour,
Pour répondre à la demande dans l'absolu (code jetable):
VB:
Sub Set_Nom()
Dim LastRow As Long, Ligne As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Ligne = Range("B2:B" & LastRow).Find("*", , , , xlByColumns, xlPrevious).Row + 1
    Range("B" & Ligne & ":B" & LastRow) = "Nom2"
End Sub

Mais après réflexion en analysant les 2 demandes, 🤔
je pense que le mieux serait de faire l'action suivante lors du coller du bloc externe :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Last_Action As String, A As Variant, Nom As String
   
    A = Split(Replace(Target.Address & "$$", ":", ""), "$")
   ' Bloc à exécuter que si la sélection concerne les colonnes A à F
    If A(1) = "A" And A(3) = "F" Then
        On Error Resume Next
            With Application.CommandBars("Standard")
                Last_Action = .Controls(.FindControl(ID:=128).Index).List(1)
            End With
        On Error GoTo 0
        If Last_Action = "Coller" Then
            Nom = InputBox("Entrez le nom pour le bloc collé")
            If Nom <> "" Then Selection.Columns(2) = Nom
            Tri_Me
        End If
    End If
   
End Sub
A mettre dans le code de la feuille.
 

Aloha

XLDnaute Accro
Bonjour,
Merci pour ce code.
Entretemps je m'avais réussi à fabriquer qch moi-même.
"Nom2" représente ici le nom qui est sur chacune des 130 feuilles copiées. Il faut le prendre là après le triage et le coller dans la colonne B.

En ce moment je suis occupé à intégrer l'action de copier les données dans un code déjà existant qui parcourt toutes les feuilles de tous les classeurs pour y prendre des valeurs.
Ce qui permet de l'occasion où le code prend les valeurs dans une feuille pour copier en même temps tous les symboles.
 

fanch55

XLDnaute Barbatruc
En ce moment je suis occupé à intégrer l'action de copier les données dans un code déjà existant qui parcourt toutes les feuilles de tous les classeurs pour y prendre des valeurs.
Ce qui permet de l'occasion où le code prend les valeurs dans une feuille pour copier en même temps tous les symboles.
L'erreur 1004 indique que (probablement) le tri ne se fait pas sur la bonne feuille.
Le code ci-dessous est plus strict mais doit être appelé explicitement par l'une des 3 façons listées:
  • Tri_Me Sheets("Feuil1")
  • Tri_Me ThisWorkbook.Sheets("Feuil1")
  • Tri_Me Workbooks("nom du classeur.xlsm").Sheets("Feuil1")

VB:
Sub Tri_Me(Sh As Worksheet)
    MsgBox "On va trier la Feuille " & Sh.Name
    With Sh.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Sh.Range("B2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Sh.Range("A2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Sh.Range("A2:F" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 

fanch55

XLDnaute Barbatruc
Je ne peux pas intégrer le code dans une Sub() existante?
Si , mais pas avec le mot-clé activesheet si vous êtes sur une autre ...
VB:
.......
.......
Dim Sh As Worksheet
Set Sh = Sheets("Feuil1")
    With Sh.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Sh.Range("B2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Sh.Range("A2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Sh.Range("A2:F" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
....
....
....
 

Statistiques des forums

Discussions
315 136
Messages
2 116 632
Membres
112 818
dernier inscrit
waity