Tri "automatique" colonnes

Bonjour à tous.

Je viens vers vous car j'ai besoin d'un petit coup de main

Dans le but d'aider un ami dans son travail je me suis mis à travailler sur du VBA. Malheureusement je suis bloqué

Donc comme le titre l'indique, j'aimerai faire un tri des colonnes dans un ordre bien précis. En farfouillant un peu sur internet j'ai trouvé quelque chose de plutôt simple à mettre en place et qui fonctionne bien.

Sub tri()
Dim texte As Range
    With Worksheets(1)

        'Recherche du texte "mail" Colonne A
        Set texte = .Rows(1).Find("mail", LookIn:=xlValues, lookat:=xlWhole)
        If Not texte Is Nothing And texte.Column <> 1 Then
            texte.EntireColumn.Cut
            .Columns("A:A").Insert Shift:=xlToRight
        End If

        'Recherche du texte "prenom"
        Set texte = .Rows(1).Find("prenom", LookIn:=xlValues, lookat:=xlWhole)
        If Not texte Is Nothing And texte.Column <> 2 Then
            texte.EntireColumn.Cut
            .Columns("B:B").Insert Shift:=xlToRight
        End If

Mais j'ai un petit souci : la macro plante si je supprime,de la première ligne, un mot que je recherche. Si je supprime d'une cellule le mot "mail" ma macro s’arrête

Je suppose qu'il faut rajouter une condition mais je ne sais pas comment et quoi mettre dans cette dernière.

Autre petite question je n'ai pas trop compris le sens du

Not ... Is Nothing

Je vous remercie par avance

Bonne journée

gloer a écrit :

Autre petite question je n'ai pas trop compris le sens du

Not ... Is Nothing

Bonjour,

Ta plage "Texte" est définie à partir d'une recherche sur le mot "mail". Si cette recherche ne donne aucune correspondance, texte ne sera donc pas une plage mais "rien" ("nothing" en anglais).

Le problème, c'est que tu contrôles dans la même ligne que texte est une plage, et qu'elle n'a pas une position spécifique. Or, si texte ne correspond à rien, Excel ne pourra pas trouver sa position (en clair, si : texte Is nothing --> texte.column n'existe pas et fait planter la macro). Il faut donc dissocier ces contrôles sur 2 lignes, la seconde condition ayant besoin que la première soit valide.

Un exemple avec le premier bloc :

Sub tri()
Dim texte As Range
    With Worksheets(1)
        'Recherche du texte "mail" Colonne A
        Set texte = .Rows(1).Find("mail", LookIn:=xlValues, lookat:=xlWhole)
        If Not texte Is Nothing Then
            If texte.Column <> 1 Then
                texte.EntireColumn.Cut
                .Columns("A:A").Insert Shift:=xlToRight
            End If
        End If
    End With
End Sub

Bonjour/Bonsoir

La modification que vous me proposer marche très bien . Merci Pedro22

J'ai cependant un cas un peu spécial qui est apparut. En faisant quelques test de tri

Sub tri()
Dim texte As Range
    With Worksheets(1)

        'Recherche du texte "mail" Colonne A
        Set texte = .Rows(1).Find("mail", LookIn:=xlValues, lookat:=xlWhole)
        If Not texte Is Nothing Then
            If texte.Column <> 1 Then
            texte.EntireColumn.Cut
            .Columns("A:A").Insert Shift:=xlToRight
            End If
        End If

        'Recherche du texte "prenom" Colonne B
        Set texte = .Rows(1).Find("prenom", LookIn:=xlValues, lookat:=xlWhole)
        If Not texte Is Nothing Then
            If texte.Column <> 2 Then
            texte.EntireColumn.Cut
            .Columns("B:B").Insert Shift:=xlToRight
            End If
        End If

        'Recherche du texte "nom" Colonne C
        Set texte = .Rows(1).Find("Nom", LookIn:=xlValues, lookat:=xlWhole)
        If Not texte Is Nothing Then
            If texte.Column <> 3 Then
            texte.EntireColumn.Cut
            .Columns("C:C").Insert Shift:=xlToRight
            End If
        End If

        'Recherche du texte "numero" Colonne D
        Set texte = .Rows(1).Find("numero", LookIn:=xlValues, lookat:=xlWhole)
        If Not texte Is Nothing Then
            If texte.Column <> 4 Then
            texte.EntireColumn.Cut
            .Columns("D:D").Insert Shift:=xlToRight
            End If
        End If

        'Recherche du texte "adresse" Colonne A
        Set texte = .Rows(1).Find("adresse", LookIn:=xlValues, lookat:=xlWhole)
        If Not texte Is Nothing Then
            If texte.Column <> 5 Then
            texte.EntireColumn.Cut
            .Columns("E:E").Insert Shift:=xlToRight
            End If
        End If
    End With
End Sub

Je met "numero" dans la colonne A et dans ma macro je veux qu'il se place en D

Cependant "numéro se place en C

Je suppose que le problème est du à la fonction cut puis insert.

Dans le vrai fichier excel , on peux se retrouver a 26 colonnes mais toutes ne seront pas forcement utilisé. Nous allons donc nous retrouver avec des colonnes vides. Est-il possible de supprimer ces dernières

J'ai trouvé un bout de code que j'ai essayer d'adapter et qui à l'air de fonctionner. Y a t-il d'autre solution?

Sub sup_col_vides()
Dim c
For c = 26 To 1 Step -1
If Cells(1, c) = "" Then Cells(1, c).EntireColumn.Delete
Next c
End Sub

Est-il possible de garder les colonnes en dehors des 26 premières colonnes fixe. J'entends par la que, quand je vais supprimer des colonnes toutes les colonnes après la colonnes Z vont se retrouver dans ces 26 première colonnes

Merci encore

Cordialement

Bonjour,

Je t'invite à faire un essai avec l'enregistreur de macro pour comprendre pourquoi ta colonne "numéro" se retrouve en "C:C" et pas en "D:D" !

Cette colonne se trouvait initialement à gauche, avant la colonne D. Lors de l'insertion d'une colonne, l'ancienne colonne existe toujours, mais comme tu utilises "couper" (cut) et pas "copier", l'ancienne colonne est immédiatement supprimée après collage, créant ainsi un décalage. Cela ne se présente pas pour une colonne située après la colonne de destination.

Tes remaniements à répétitions sont un peu complexes, et engendrent un risque d'erreur. Je planche sur une solution un peu différente, je posterai tout ça ici !

Voilà une contribution :

Option Base 1
Sub RéorgaOnglet()

Dim PositionCible(5) As String, Col As Integer, i As Integer

PositionCible(1) = "mail"
PositionCible(2) = "prenom"
PositionCible(3) = "Nom"
PositionCible(4) = "numero"
PositionCible(5) = "adresse"

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheets("Feuil1")
    Sheets.Add After:=Sheets("Feuil1") 'Ajout d'une feuille
    ActiveSheet.Name = "NouvelOnglet" 'Renomme la feuille
    For Col = 1 To 26 'Parcourir les colonnes
        For i = LBound(PositionCible) To UBound(PositionCible) 'Parcourir les éléments à trier
            If .Cells(1, Col) = PositionCible(i) Then .Columns(Col).Copy Columns(i) 'Report si correspondance
        Next i
    Next Col
    For Col = Cells(1, .Columns.Count).End(xlToLeft).Column To 1 Step -1 'Parcourir les colonnes
        If IsEmpty(Cells(1, Col)) Then Columns(Col).Delete 'Suppression colonne si vide
    Next Col
    .Range(.Cells(1, 27), .Cells(1, .Columns.Count)).EntireColumn.Copy Range("AA1") 'Copie des colonnes restantes (hors 26 premières)
    If MsgBox("Supprimer l'onglet original ?", vbYesNo) = vbYes Then .Delete 'Suppression de l'onglet original
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Le code permet filtrer et copié les colonnes définies et dans l'ordre voulue, sans colonne intercalaire vide.

Les colonnes après la colonne Z sont reportées telles quelle.

Bonjour

Quelle contribution!

On comprend vite avec les commentaire et du coup on peux adapter facilement.

De mon côté j'étais partie sur un truc "un peu" lourd consistant à forcement mettre la valeur à droite de la colonne désiré et de la ramener au bon endroit mais ça fonctionne pas tout à fait

 'Recherche du texte "prenom" Colonne B
        Set Texte = .Rows(1).Find("prenom", LookIn:=xlValues, lookat:=xlWhole)
            If Not Texte Is Nothing Then
            If Texte.Column < 2 Then
            Texte.EntireColumn.Cut
            .Columns("AC:AC").Insert
            Texte.EntireColumn.Cut
            .Columns("B:B").Insert
            ElseIf Texte.Column > 2 Then
            Texte.EntireColumn.Cut
            .Columns("B:B").Insert Shift:=xlToRight
            End If
            End If

 'Recherche du texte "Nom" Colonne C
        Set Texte = .Rows(1).Find("Nom", LookIn:=xlValues, lookat:=xlWhole)
            If Not Texte Is Nothing Then
            If Texte.Column < 3 Then
            Texte.EntireColumn.Cut
            .Columns("AC:AC").Insert
            Texte.EntireColumn.Cut
            .Columns("C:C").Insert
            ElseIf Texte.Column > 3 Then
            Texte.EntireColumn.Cut
            .Columns("C:C").Insert Shift:=xlToRight
            End If
            End If

Je me suis juste mal exprimé sur la sauvegarde des données après les 26 premières colonnes.

J'étais parti sur le précédent code qui décaler les colonnes "jusqu'à les faire sortir" des données à trier

Une capture c'est plus simple pour expliquer .

En tout cas , un réel grand merci .

Cela va permettre à mon ami de gagner du temps