Déplacer des colonnes dans un ordre en vba

B

bloublou

XLDnaute Occasionnel
Bonsoir à tous,

Je voudrais déplacer les colonnes de la feuille 1 dans l'ordre de la feuille 2 en vba ? :confused:

Pouvez-vous m'aider ?

Bonne nuit

BlouBlou
 

Pièces jointes

  • Classeur1.xls
    18.5 KB · Affichages: 92
  • Classeur1.xls
    18.5 KB · Affichages: 97
  • Classeur1.xls
    18.5 KB · Affichages: 88
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Bonjour bloublou, 00 :)

Ce problème de classement de colonnes est intéressant, je mets un Like au post #1.

Chère ânesse j'espère que tu ne m'en voudras pas de squatter ton fichier.

La macro :

Code: 
Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim col%, P1 As Range, P2 As Range, i%, n
Application.ScreenUpdating = False
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
Set P1 = Feuil1.Columns(1).Resize(, col)
Set P2 = Feuil2.Rows(1)
1 For i = 1 To col
  If P1.Cells(1, i) <> "" Then
    n = Application.Match(P1.Cells(1, i), P2, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      P1.Columns(i).Cut
      P1.Columns(n + 1).Insert
      GoTo 1
    End If
  End If
Next
Application.Goto P1.Cells(1)
End Sub
A+
 

Pièces jointes

  • Classer les colonnes(1).xls
    61.5 KB · Affichages: 79
Vote positif 0 Vote négatif
DoubleZero

DoubleZero

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Re-bonjour, bonjour, job75 :D,

job75 à dit:
... j'espère que tu ne m'en voudras pas de squatter ton fichier...
Cliquez pour agrandir...

Moi ? T'en vouloir ? En ai-je l'air :mad: ?
attachment.php

​
Bravo, job75 et...

... A bientôt :D:D
 

Pièces jointes

  • Moi, t'en vouloir (point d'interrogation !).jpeg
    Moi, t'en vouloir (point d'interrogation !).jpeg
    29.3 KB · Affichages: 151
  • Moi, t'en vouloir (point d'interrogation !).jpeg
    Moi, t'en vouloir (point d'interrogation !).jpeg
    29.3 KB · Affichages: 193
  • Moi, t'en vouloir (point d'interrogation !).jpeg
    Moi, t'en vouloir (point d'interrogation !).jpeg
    29.3 KB · Affichages: 201
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Re,

Il vaut mieux utiliser cette macro :

Code: 
Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim col1%, col%, P1 As Range, P2 As Range, i%, n
Application.ScreenUpdating = False
col1 = Feuil1.Cells(1, Feuil1.Columns.Count).End(xlToLeft).Column
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
Set P1 = Feuil1.Columns(1).Resize(, col)
Set P2 = Feuil2.Rows(1)
1 For i = 1 To col
  If P1.Cells(1, i) <> "" Then
    n = Application.Match(P1.Cells(1, i), P2, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      P1.Columns(i).Cut
      P1.Columns(n - (i < n)).Insert 'True se convertit en -1
      GoTo 1
    End If
  End If
Next
Application.Goto P1.Parent.[A1]
End Sub
Elle permet de traiter le cas où le n° de la dernière colonne (col1) en Feuil1 est supérieur à cellui de Feuil2.

Fichier (2), mais testez aussi cette macro sur le fichier (1).

A+
 

Pièces jointes

  • Classer les colonnes(2).xls
    60 KB · Affichages: 57
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Re,

La variable P1 compliquait inutilement la compréhension, ceci est plus simple :

Code: 
Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim F As Worksheet, col1%, col%, P As Range, i%, n
Application.ScreenUpdating = False
Set F = Feuil1
col1 = F.Cells(1, F.Columns.Count).End(xlToLeft).Column
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
Set P = Feuil2.Rows(1).Resize(, col)
1  For i = 1 To col
  If F.Cells(1, i) <> "" Then
    n = Application.Match(F.Cells(1, i), P, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      F.Columns(i).Cut
      F.Columns(n - (i < n)).Insert 'True se convertit en -1
      GoTo 1
    End If
  End If
Next
Application.Goto F.[A1]
End Sub
Fichier (3).

A+
 

Pièces jointes

  • Classer les colonnes(3).xls
    54 KB · Affichages: 68
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Bonjour bloublou, 00, le forum,

bloublou à dit:
la macro serait équivalente si c'était sur la même feuille que l'on déplacerait les colonnes ?
Cliquez pour agrandir...

Justement les solutions précédentes déplacent les colonnes uniquement sur Feuil1.

Si l'on utilise Feuil2 c'est bien plus simple :

Code: 
Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, P As Range, i%, n
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames
Set P = Feuil2.Rows(1)
For i = 1 To F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
  If F1.Cells(1, i) <> "" Then
    n = Application.Match(F1.Cells(1, i), P, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
    F1.Columns(i).Copy F2.Cells(1, n)
  End If
Next
If IsError(n) Then F2.Rows("2:" & F2.Rows.Count).Delete
Application.Goto F2.[A1]
End Sub
Le copier/coller d'une feuille à l'autre suffit.

Fichiers (4) et (4 bis).

A+
 

Pièces jointes

  • Classer les colonnes(4).xls
    60 KB · Affichages: 66
  • Classer les colonnes(4 bis).xls
    61 KB · Affichages: 57
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Re,

Je reviens sur le déplacement des colonnes en Feuil1 en exploitant les excellentes idées de DoubleZero :

- insertion d'une ligne auxiliaire

- tri de gauche à droite :

Code: 
Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, col%
Dim P As Range, c As Range, r As Range
Application.ScreenUpdating = False
Set F1 = Feuil1: Set F2 = Feuil2
col = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
Set P = F2.[A1].Resize(, col + 1)
F1.[1:1].Insert 'ligne auxiliaire
For Each c In F1.[A2].Resize(, col)
  Set r = P.Find(c, P(col + 1), xlValues, xlWhole)
  If r Is Nothing Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
  c(0) = r.Column
  If r = "" Then r.EntireColumn.Hidden = True 'masque la colonne
Next
If Not r Is Nothing Then F1.Columns(1).Resize(, col) _
  .Sort F1.[A1], xlAscending, Header:=xlNo, Orientation:=xlLeftToRight 'tri
F1.[1:1].Delete 'suppression de la ligne auxiliaire
F2.Columns(1).Resize(, col).Hidden = False 'affichage des colonnes
Application.Goto F1.[A1]
End Sub
Avec le tri l'exécution est bien plus rapide.

Evidemment il y a des astuces (masquage des colonnes par exemple) pas faciles à comprendre :cool:

Fichier (5).

A+
 

Pièces jointes

  • Classer les colonnes(5).xls
    63.5 KB · Affichages: 64
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Bonjour bloublou DoubleZero Gerard

Un essai avec un code peut être un peu plus facile à comprendre a défaut d’être aussi rapide

Code: 
Sub essai()
Dim dercol As Integer, derlin As Integer, tablo
Dim n As Integer, m As Integer, col As Integer, y As Range
dercol = Sheets("Feuil1").Cells(1, Columns.Count).End(xlToLeft).Column
derlin = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
tablo = Sheets("Feuil1").Range(Cells(1, 1).Address & ":" & Cells(derlin, dercol).Address)
Sheets("Feuil1").Range(Cells(1, 1).Address & ":" & Cells(derlin, dercol).Address).ClearContents
Sheets("Feuil2").Rows(1).Copy Destination:=Sheets("Feuil1").Range("A1")
Application.ScreenUpdating = False
For n = LBound(tablo, 2) To UBound(tablo, 2)
  Set y = Sheets("Feuil1").Rows(1).Find(tablo(LBound(tablo, 1), n), LookIn:=xlValues, lookat:=xlWhole)
  col = y.Column
  For m = LBound(tablo, 1) + 1 To UBound(tablo, 1)
    Sheets("Feuil1").Cells(m, col) = tablo(m, n)
  Next
Next
Application.ScreenUpdating = False
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Bonjour pierrejean :)

D'accord mais la durée d'exécution peut avoir son importance.

Vois les 2 "petits" fichiers joints avec 10006 lignes.

Mon fichier utilise la version (5) de mon post #10.

A+
 

Pièces jointes

  • Petit fichier de pierrejean(1).zip
    189.9 KB · Affichages: 43
  • Petit fichier de job75(1).zip
    190 KB · Affichages: 44
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Déplacer des colonnes dans un ordre en vba

Bonjour bloublou, Pierre, le forum,

Ah j'avais oublié le cas où la dernière colonne en Feuil1 est supérieure à celle en Feuil2.

Utilisez donc cette macro qui fonctionne dans tous les cas :

Code: 
Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, col1%, col%, c As Range, r As Range
Application.ScreenUpdating = False
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames des feuilles
col1 = F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
col = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
F1.[1:1].Insert 'ligne auxiliaire
For Each c In F1.[A2].Resize(, col)
  Set r = F2.[A1].Resize(, col).Find(c, , xlValues, xlWhole)
  If r Is Nothing Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
  c(0) = r.Column
  If r = "" Then r.EntireColumn.Hidden = True 'masque la colonne
Next
If Not r Is Nothing Then F1.Columns(1).Resize(, col) _
  .Sort F1.[A1], xlAscending, Header:=xlNo, Orientation:=xlLeftToRight 'tri
F1.[1:1].Delete 'suppression de la ligne auxiliaire
F2.Columns(1).Resize(, col).Hidden = False 'affichage des colonnes
Application.Goto F1.[A1]
End Sub
Fichier (6).

A+
 

Pièces jointes

  • Classer les colonnes(6).xls
    62.5 KB · Affichages: 77
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
XL 2021 sélection de colonne et ordonnancement des colonnes en déclarant en variable les entêtes
Réponses
2
Affichages
142
ftpo69
F
P
  • Question
XL 2021 Remplacer des formules matricielle par code VBA
Réponses
12
Affichages
226
TooFatBoy
TooFatBoy
C
  • Question
XL pour MAC trier des données tableau excel selon ordre donné
2
Réponses
16
Affichages
778
clineM
C
M
  • Question
Microsoft 365 interdire l'ajout et la suppression de lignes et de colonnes en vba
Réponses
9
Affichages
128
Eric C
Eric C
Caninge
  • Question
XL 2019 Validation de Données sur plusieurs colonnes
2
Réponses
26
Affichages
783
Caninge
Caninge
C
  • Question
XL 2021 VBA pour comparer des données
Réponses
7
Affichages
259
Cristobal
C
L
  • Question
Microsoft 365 masquer colonne + MDP
Réponses
2
Affichages
158
l.et.lilou
L
Z
  • Question
Microsoft 365 Help! j'ai besoin d'automatiser un fichier via formule ou autres
Réponses
9
Affichages
382
DJunqueira
D
Philippe17
  • Résolu(e)
Microsoft 365 Code VBA pour un Formulaire
2
Réponses
17
Affichages
639
patricktoulon
patricktoulon
klin89
  • Résolu(e)
Microsoft 365 Affecter des valeurs à 2 variables tableau en comparant 2 séquences d'éléments pour remplir une colonne
2 3 4
Réponses
50
Affichages
3 K
RyuAutodidacte
RyuAutodidacte

Membres actuellement en ligne

10 membres et 156 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 201
Messages
2 086 172
Membres
103 152
dernier inscrit
Karibu