Macro pour Trier des Tableaux

Bonjour

Question VBA

Une Feuille récapitule les contrats qui à mesure de leur création viennent s'insérer avant le dernier de la liste (Contrat de référence)

Tous ces contrats ont 17 lignes et leur nom en alpha numérique est sur la première de ces 17 lignes en Colonne A

Chacun d'entre eux forme donc un Tableau de 17 lignes

Le premier tableau commence à la ligne 4

Les 9 dernières lignes ne sont pas concernées et doivent rester en fin de Page.

Le nombre de Tableaux est évolutif.

Question

Comment rétablir l'ordre alphanumérique des contrat ou comment trier les Tableaux.

Un fichier exemple est joint.

Merci aux participants

Cordialement

Bonjour Amadeus

J'ai remplacé les cellules fusionnées par un "Centré sur plusieurs colonnes"

Amicalement

Nad

Bonjour

Bonjour Nad

Ma petite idée

Edit : Très bonne idée Nad

Edit de Nad : Merci - J'ai un bon professeur ...

Bonjour Nad, Banzai64

Les 2 macros fonctionnent parfaitement ce dont je ne doutais pas un instant.

Si Nad a un bon prof, le mauvais éléve que je suis en a au moins 2 sur le sujet.

merci à vous deux

Amicalement

Bonjour à tous,

J'arrive à la bourre, je poste quand même

çà n'a pas la classe de Banzai64, mais bon !

Sub Tri()
Dim Lg%, i%, J%
        Application.ScreenUpdating = False
        Lg = Range("a65536").End(xlUp).Row - 1

    Rows("4:" & Lg).Hidden = False                      'mode plan Affiche
    Range("A4:O" & Lg).UnMerge                          'défusionne tout

        For i = 4 To Lg                                 'numérote pour 2ème clé de tri
            Cells(i, "r") = i + 100
        Next i

    For i = 4 To Lg Step 17                             'formule (Nom contrat)
        Range(Cells(i, "q"), Cells(i + 16, "q")) = "=$a$" & i & ""
    Next i
    Columns("q") = Columns("q").Value                   'en dur

    '--- tri ---
    Range("a4:r" & Lg).Sort Key1:=Range("q4"), Order1:=xlAscending, Key2:=Range("r4") _
        , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom

        Range("q:r").EntireColumn.ClearContents

    '--- refusionne ---
    For i = 4 To Lg Step 17
        Range(Cells(i, "a"), Cells(i, "e")).Merge 'titre contrat
        Range(Cells(i + 1, "d"), Cells(i + 1, "g")).Merge
        Range(Cells(i + 1, "i"), Cells(i + 1, "k")).Merge
        Range(Cells(i + 1, "m"), Cells(i + 1, "o")).Merge
            For J = i + 3 To i + 11
                Range(Cells(J, "b"), Cells(J, "c")).Merge
            Next J
        Range(Cells(i + 5, "m"), Cells(i + 6, "m")).Merge
        Range(Cells(i + 5, "n"), Cells(i + 6, "n")).Merge
        Range(Cells(i + 5, "o"), Cells(i + 6, "o")).Merge
    Next i
End Sub

Amicalement

Claude

Bonjour Claude

çà n'a pas la classe de Banzai64, mais bon !

Je viens de tester et c'est aussi très efficace.

Pour la classe, je ne peux pas être juge..vu mon niveau VBA.

Je peux donc confirmer à nad que j'ai un prof de plus qu'elle.

Merci à toi

Bonjour

Juste pour dire que Nad à fait un bien meilleur code (plus concis, très efficace donc plus rapide)

Moi suis dans le style "pourquoi faire simple quand on peut faire compliqué"

Bonne journée à tous

faut que pense à appliquer la maxime de Claude

Bonsoir à tous,

Sujet intéressant, j'y suis revenu !

Partant du principe que les noms définis sont classés alpha.

ici, je nomme temporairement les plages.

Je me suis inspiré de la macro de Banzai64

Sub Tri()
Dim Lg%, i%
Dim Nms As Name
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Lg = Range("a65536").End(xlUp).Row - 1
    Sheets("Situation Globale").Copy Before:=Sheets(1)              'copie feuille

    For i = 4 To Lg Step 17                                         'nomme plages
        Range(Cells(i, "a"), Cells(i + 16, "o")).Name = _
        "zzzz" & Application.Substitute(Cells(i, "a"), " ", "_")    'nom temporaire sans espace
    Next i

            i = 4
    With Sheets("Situation Globale")
        For Each Nms In Names
            If Left(Nms.Name, 4) = "zzzz" Then                      'copie plage nommée
                Range(Nms).Copy Destination:=.Cells(i, "a")
                Nms.Delete                                          'supprime nom
                i = i + 17
            End If
        Next Nms
    End With
    Sheets(1).Delete
End Sub

Bonne soirée

Claude

édit: comme quoi c'est pas si facile de faire simple !

Bonjour Claude

sur le fichier exemple, le dernier code tourne impeccable.

cependant, sur le fichier réel (contrôlé pour les tableaux) et où les autres Codes reçus fonctionnent, j'ai une erreur sur la ligne

      Range(Cells(i, "a"), Cells(i + 16, "o")).Name = _
        "zzzz" & Application.Substitute(Cells(i, "a"), " ", "_")    'nom temporaire sans espace

erreur 1004

Nom non valide

Ps: J'ai remis le sujet en Non résolu juste pour attirer ton attention

Cordialement

Bonjour Amadéus, forum,

Comment sont libellés les Contrats en A4, A21, A38 etc.. ? , donne un exemple

il doit y avoir des caractères interdits pour nommer (style "/" ou autres)

auquel cas, il faut les remplacer (dans la macro)

Cette méthode n'est peut-être pas fiable ?

C'était juste un exercice pour essayer de progresser en VBA

Bonne journée

Claude

Bonjour Claude

Exact, il y a des /

Encore merci