Permuter (Inverser) deux ranges

Bonjour à tous,

J’aimerais inverser deux ranges qui se trouvent dans la plage : "N2 : P" & dernière_Ligne1

Pour plus de facilité dans la sélection, je ne ferais la sélection que dans la colonne "N", on choisissant deux cellules des deux lignes concernées, cela veut dire que, quand je sélectionne par exemple la cellule "N5", il s’agit de l’ensemble du range en jaune, et lorsque je sélectionne par exemple la cellule "N10", il s’agit du range coloré en vert.

Lorsque je clique le bouton "Permuter" après avoir sélectionné mes deux cellules "N5" et "N10", l’inversion de ces deux ranges devrait se faire, le résultat se trouve dans la feuille " Résultat_souhaité".

Il serait vraiment pratique que ce même bouton puisse aussi traiter la zone "R2 : T" & dernière_Ligne2, (Zone encadrée en Rouge) de la même manière lorsque je sélectionne les deux cellules en colonne "R"

Je reste à votre disposition pour d’autres informations supplémentaires.

Merci d’avance de vous propositions

Bonjour Harzer ,

Sélectionner deux cellules (une cellule dans chaque ligne à intervertir - pas forcément dans la même colonne mais dans le même groupe de colonnes N:P ou R:T).

Puis cliquer sur le bouton Permuter qui lance la macro Inverser_Deux_Ranges() dans module2.

nota : on ne vérifie pas si les lignes à permuter sont vides ou non (on pourrait le faire si besoin)

Sub Inverser_Deux_Ranges()
Dim x1 As Range, x2 As Range
   If Selection.Count <> 2 Then Exit Sub
   If Selection.Areas.Count = 1 Then
      Set x1 = Selection(1): Set x2 = Selection(2)
   Else
      Set x1 = Selection.Areas(1): Set x2 = Selection.Areas(2)
   End If
   If x1.Column >= Range("n1").Column And x1.Column <= Range("p1").Column And _
      x2.Column >= Range("n1").Column And x2.Column <= Range("p1").Column Then
      Cells(x1.Row, "n").Resize(, 3).Copy Cells(Rows.Count, "n")
      Cells(x2.Row, "n").Resize(, 3).Copy Cells(x1.Row, "n")
      Cells(Rows.Count, "n").Resize(, 3).Copy Cells(x2.Row, "n")
      Rows(Rows.Count).Clear
   ElseIf x1.Column >= Range("r1").Column And x1.Column <= Range("t1").Column And _
      x2.Column >= Range("r1").Column And x2.Column <= Range("t1").Column Then
      Cells(x1.Row, "r").Resize(, 3).Copy Cells(Rows.Count, "r")
      Cells(x2.Row, "r").Resize(, 3).Copy Cells(x1.Row, "r")
      Cells(Rows.Count, "r").Resize(, 3).Copy Cells(x2.Row, "r")
      Rows(Rows.Count).Clear
   End If
End Sub

Re,

Version V1a. On a ajouté les deux conditions concernant dernière_Ligne1 et dernière_Ligne2.

Le code :

Sub Inverser_Deux_Ranges()
Dim x1 As Range, x2 As Range, derligN&, derligR&
   With ActiveSheet
      If Selection.Count <> 2 Then Exit Sub
      If Selection.Areas.Count = 1 Then
         Set x1 = Selection(1): Set x2 = Selection(2)
      Else
         Set x1 = Selection.Areas(1): Set x2 = Selection.Areas(2)
      End If
      If .FilterMode Then .ShowAllData
      derligN = .Cells(Rows.Count, "n").End(xlUp).Row
      derligR = .Cells(Rows.Count, "r").End(xlUp).Row
      If x1.Row < 2 Or x2.Row < 2 Then Exit Sub
      If x1.Column >= Range("n1").Column And x1.Column <= Range("p1").Column And _
            x2.Column >= Range("n1").Column And x2.Column <= Range("p1").Column And _
            x1.Row <= derligN And x2.Row <= derligN Then
         Cells(x1.Row, "n").Resize(, 3).Copy Cells(Rows.Count, "n")
         Cells(x2.Row, "n").Resize(, 3).Copy Cells(x1.Row, "n")
         Cells(Rows.Count, "n").Resize(, 3).Copy Cells(x2.Row, "n")
      ElseIf x1.Column >= Range("r1").Column And x1.Column <= Range("t1").Column And _
            x2.Column >= Range("r1").Column And x2.Column <= Range("t1").Column And _
            x1.Row <= derligR And x2.Row <= derligR Then
         Cells(x1.Row, "r").Resize(, 3).Copy Cells(Rows.Count, "r")
         Cells(x2.Row, "r").Resize(, 3).Copy Cells(x1.Row, "r")
         Cells(Rows.Count, "r").Resize(, 3).Copy Cells(x2.Row, "r")
      End If
      Rows(Rows.Count).Clear
   End With
End Sub

Bonjour mafraise et à tout le monde,

Grand MERCI à vous (Mafraise) pour vos deux propositions et les explications qui accompagnent la première solution.

Les deux propositions fonctionnent bien et me donnent entière satisfaction.

C’est vrai que je n’ai pas pensé au cas de la permutation des ranges vides avec des ranges pleins.

Dans ce cas, pouvez-vous S-V-P traiter ce cas de la manière suivante (Si c’est possible) :

On peut autoriser la permutation d’un range vide avec un range plein, ce qui aura pour effet d’insérer un range vide ou cas ou j’en aurais besoin.

Actuellement, le 2 codes proposés traitent la permutation des groupes de colonnes "N:P" et "R:T" indépendamment l’un de l’autre, ce qui veut dire qu’on peut inverser soit les ranges du groupe des colonnes "N:P" ou soit les ranges du Groupe "R:T".

Toutefois, je me pose la question suivante : si en choisi par exemple : deux cellules dans le groupe "N:P" (à permuter entre eux) et au même temps deux cellules dans le groupe "R:T" (à permuter entre eux), ce qui nous donne donc 4 cellules au total.

Y’a-t-il possibilité d’inverser les 4 ranges dans les deux groupes (en une fois) avec un seul click sur le bouton "Permuter"?

Si ce n’est pas possible, je peux vous assurer que je suis très content déjà des deux propositions qui me donnent une total satisfaction.

À vous lire.

Bonjour ,

Toutefois, je me pose la question suivante : si en choisi par exemple : deux cellules dans le groupe "N:P" (à permuter entre eux) et au même temps deux cellules dans le groupe "R:T" (à permuter entre eux), ce qui nous donne donc 4 cellules au total.

Y’a-t-il possibilité d’inverser les 4 ranges dans les deux groupes (en une fois) avec un seul click sur le bouton "Permuter"?

Un essai dans le classeur joint. On peut à nouveau intervenir les lignes qu'elles soient vides ou non. Le code a été adapté.

nota : on peut éventuellement ajouter ou retirer des plages de 3 colonnes en modifiant la ligne de code : For Each xPlageCols In Array("n:p", "r:t")

Sub Inverser_Deux_Ranges()
Dim xPlageCols, colInf&, colSup&, xrg As Range, x1 As Range, x2 As Range
   With ActiveSheet
      For Each xPlageCols In Array("n:p", "r:t")
         colInf = .Columns(xPlageCols).Column: colSup = colInf + .Columns(xPlageCols).Columns.Count - 1
         Set xrg = Intersect(.Columns(xPlageCols), Selection)
         If Not xrg Is Nothing Then
            If xrg.Count = 2 Then
               If xrg.Areas.Count = 1 Then
                  Set x1 = xrg(1): Set x2 = xrg(2)
               Else
                  Set x1 = xrg.Areas(1): Set x2 = xrg.Areas(2)
               End If
               If x1.Row >= 2 And x2.Row >= 2 Then
                  If x1.Column >= colInf And x1.Column <= colSup And _
                        x2.Column >= colInf And x2.Column <= colSup Then
                     Cells(x1.Row, colInf).Resize(, 3).Copy Cells(Rows.Count, colInf)
                     Cells(x2.Row, colInf).Resize(, 3).Copy Cells(x1.Row, colInf)
                     Cells(Rows.Count, colInf).Resize(, 3).Copy Cells(x2.Row, colInf)
                     Rows(Rows.Count).Clear
                  End If
               End If
            End If
         End If
      Next xPlageCols
   End With
End Sub

Bonjour mafraise,

Merci pour le retour, c’est vraiment gentil d’être disponible et de consacrer du temps pour les autres.

Votre mise à jour me satisfait et réponds à mes attentes, c’est Parfait.

Je vous remercie et je vous souhaite le meilleur (Après tous, nous sommes toujours en mois de janvier 2024).

Cordiale poignées de mains et au plaisir de se lira dans Excel-Pratique.

Salutations.

Bonjour,

Une version v3 qui généralise le concept :

• qui traite un nombre variable de groupes de colonnes grâce à la constante ColUtiles dans le code. Exemple : Const ColUtiles = "d:h,n:p,r:t"
• qui accepte que les groupes de colonnes aient chacun un nombre différent de colonnes
• qui accepte que la sélection aient plus de deux cellules sélectionnées dans chaque groupe de colonnes. Il faut néanmoins que les cellules sélectionnées dans chaque groupe de colonnes soient réparties sur deux lignes exactement (pas 1 et pas 3 ou plus) sinon on abandonne l'échange pour chaque groupe ne respectant pas cette condition.
• Si un groupe de colonnes ne répond pas aux conditions, le traitement passe au groupe suivant.
• qui refuse tout le traitement si la sélection comporte au moins une cellule en dehors de l'ensemble des groupes de colonnes (aucun échange)
• qui accepte l'échange avec des lignes vides

Le nouveau code est commenté :

Sub Inverser_Deux_Ranges()
Const ColUtiles = "d:h,n:p,r:t"                  ' plage colonnes séparées par une virgule
Dim xPlageCols, colInf&, colSup&, colNbr&, xrgSelection As Range
Dim xrg As Range, x1 As Range, x2 As Range, aux As Range
   With ActiveSheet
      ''''''' Union(.Range("b2"), .Range("toto")).Select
      Set xrgSelection = Selection               ' mémorisation de la sélection
      ' test si des cellules sont sélectionnées en dehors des plages de colonnes désirées
      ' si oui alors on abandonne le traitement => sortie
      Set aux = Intersect(.Range(ColUtiles), xrgSelection)
      If aux.Count <> xrgSelection.Count Then Exit Sub
      'boucle sur les plages de colonnes désirées
      For Each xPlageCols In Split(ColUtiles, ",")
         colInf = .Columns(xPlageCols).Column    ' N° première colonne de la plage courante
         colNbr = .Columns(xPlageCols).Columns.Count ' N° dernière colonne de la plage courante
         colSup = colInf + colNbr - 1            ' Nombre de colonnes de la plage courante
         ' range des cellules de la première colonne de la sélection
         ' au sein de la plage courante xPlageCols
         ' intersection de la sélection et de la plage courante
         Set xrg = Intersect(xrgSelection, .Columns(xPlageCols))
         ' si aucune cellule dans la plage courante, on passe à la plage suivante
         If xrg Is Nothing Then GoTo PlageSuiv
         ' cellules de la première colonne de la plage courante et des lignes
         ' de la sélection comprise dans la plage courante
         Set xrg = Intersect(.Columns(colInf), xrg.EntireRow) ' intersection avec 1ère colonne de la plage courante
         ' si la sélection n'a pas exactement 2 cellules (ou lignes),
         ' on ne peut pas faire un échange, on passe à la plage suivante
         If xrg.Count <> 2 Then GoTo PlageSuiv
         ' on attribue à x1 et x2 les deux cellules
         If xrg.Areas.Count = 1 Then
            Set x1 = xrg(1): Set x2 = xrg(2)
         Else
            Set x1 = xrg.Areas(1): Set x2 = xrg.Areas(2)
         End If
         ' on pratique l'échange
         ' copie de la ligne x1 sur dernière ligne de la feuille
         Cells(x1.Row, colInf).Resize(, colNbr).Copy Cells(Rows.Count, colInf)
         ' copie de la ligne x2 sur la ligne x1
         Cells(x2.Row, colInf).Resize(, colNbr).Copy Cells(x1.Row, colInf)
         ' copie de la dernière ligne (ex-ligne x1 sauvegardée) sur la ligne x2
         Cells(Rows.Count, colInf).Resize(, colNbr).Copy Cells(x2.Row, colInf)
         Rows(Rows.Count).Clear     'effacement de la dernière ligne
PlageSuiv:
      Next xPlageCols
   End With
End Sub

nota : petite (ou grosse) entorse à ma méthode de programmation sans "GOTO" mais c'est bien plus commode qu'une ribambelle de If ... Endif pour passer à l'indice suivant dans une boucle For ... Next. Je ne recommencerai plus (enfin peut-être quand même )

Bonjour mafraise,

Merci pour votre retour ainsi que la nouvelle version n° 3, plus complète que jamais.

Merci aussi pour les explications qui l’accompagnent.

Un merci tout particulier pour les commentaires du code.

Je vous avoue que j’allais vous demander s’il y’aurait possibilité de commenter le code et puis je me suis dit qu’il ne fallait pas abuser, j’ai déjà une solution qui fonctionne et c’est le principal.

Maintenant, vous me proposez une 3e solution fonctionnelle et commentée, Résultat : je suis très content.

Cordiale poignée de mains et à bientôt.