Microsoft 365 Déplacer cellules en gardant mise en forme source et cible (via VBA)

[mjuju]

Bonjour,

Je souhaite déplacer des cellules en gardant la mise en forme de la source et de la cible.
Cela revient à un couper / collervaleurs mais il est impératif de rester sur une action sélection->déplacement sans actions intermédiaires.

Nous avons une série de classeur où nous souhaiterions appliquer ce VBA. Je mets en PJ l'un d'eux.
Généralement, on sélectionne plusieurs lignes de la colonne J, K, L, M que l'on déplace en C, D, E, F... (par exemple: J138:M142 déplacés en C146:F150 ou
J158:M158 déplacé en C151:F151 ou J160 en C169).

J'ai bien peur que ma demande ne soit possible: jusqu'à présent personne n'a trouvé la solution pour cette action précise!

Merci par avance,

Mjuju

 

[job75]

Bonjour mjuju, le forum,

Sélectionnez les cellules que vous voulez en colonnes J:M et exécutez cette macro :

Sub Transfert()
Dim c As Range
ActiveCell.Activate 'au cas où Selection n'est pas un Range
For Each c In Selection
    If Not Intersect(c, [J:M], ActiveSheet.UsedRange) Is Nothing And Not Cells(c.Row, 10).Validation Is Nothing Then c(1, -6) = c
Next
End Sub

Faites au besoin une sélection multiple (touche Ctrl enfoncée).

A+

 

[mjuju]

Merci
En fait il faudrait que ça s'applique partout quel que soit la sélection, la source ou la cible....

 

[job75]

La macro précédente n'est pas fameuse, utilisez celle-ci :

Sub Transfert()
Dim r As Range
ActiveCell.Activate 'au cas où Selection n'est pas un Range
Set r = Intersect(Selection, [J:M], ActiveSheet.UsedRange)
If r Is Nothing Then Exit Sub
For Each r In r 'si sélection multiple
    If Not Cells(r.Row, 10).Validation Is Nothing Then r(1, -6) = r
Next
End Sub

Elle va bien même si l'on sélectionne toutes les cellules de la feuille active.

 

[mjuju]

Bonjour,
Je suis dsl mais j'ai dû louper une étape ca ne fonctionne pas ...
Alt+F11 -> j'ai collé dans le workbook -> alt F8 exécuté

 

[job75]

En fait il faudrait que ça s'applique partout quel que soit la sélection, la source ou la cible....

Essayez la macro sur le fichier, la feuille, la sélection que vous voulez.

 

[job75]

J'ai mis le raccourci clavier Ctrl+T sur la macro du fichier post #6.

 

[mjuju]

Ha d'accord j'ai compris Ce n'est pas tout à fait ce que je souhaitais car les lignes ne se reportent pas forcement sur la même ligne.
Ca peut être:
J138:M142 déplacés en C146:F150 ou
J158:M158 déplacé en C151:F151 ou
J160 en C169 ou
inversement (des cellules des colonnes C D E F à des cellules de colonnes J K L M)

C'est pour ça que je cherche une solution qui s'applique sur n'importe quelle source à n'importe quelle cible, d'autant plus que je veux appliquer ce VBA à d'autres classeurs qui ont une mise en page totalement différent.
Les pistes que j'ai essayé sans succès:
Sélections source-> si déplacement = couper -> déplacement cible= coller valeurs
ou
Sélections source->déplacement -> garder mise en forme des cellules cibles et des cellules sources

 

[TooFatBoy]

Bonjour,

Je souhaite déplacer des cellules en gardant la mise en forme de la source et de la cible.

C'est impossible.

Il faut choisir : on garde soit la MEF de la source soit la MEF de la cible, mais on ne peut bien sûr pas garder les deux MEF pour une même cellule.

 

[mjuju]

Bonjour,


C'est impossible.

Il faut choisir : on garde soit la MEF de la source soit la MEF de la cible, mais on ne peut bien sûr pas garder les deux MEF pour une même cellule.

Pourtant une action de couper/coller valeurs conserve bien la MEF source et cible?
Et bien si on peut au moins garder la mise en forme de la cellule cible ça serait bien

 

[job75]

les lignes ne se reportent pas forcement sur la même ligne.
Ca peut être:
J138:M142 déplacés en C146:F150 ou
J158:M158 déplacé en C151:F151 ou
J160 en C169 ou
inversement (des cellules des colonnes C D E F à des cellules de colonnes J K L M)

Utilisez ces 2 macros :

Sub SelectCF()
'se lance par le raccourci Ctrl+C
Dim r As Range, lig&, decal&, dest As Range
ActiveCell.Activate 'au cas où Selection n'est pas un Range
Set r = Intersect(Selection, [C:F], ActiveSheet.UsedRange)
If r Is Nothing Then Exit Sub
lig = Abs(Int(Val(InputBox("Numéro de ligne du collage :"))))
If lig = 0 Then Exit Sub
decal = lig - Selection(1).Row
For Each r In r 'si sélection multiple
    Set dest = r(1, 8).Offset(decal)
    If Not Cells(r.Row, 3).Validation Is Nothing And Not Cells(dest.Row, 10).Validation Is Nothing Then dest = r
Next
End Sub

Sub SelectJM()
'se lance par le raccourci Ctrl+J
Dim r As Range, lig&, decal&, dest As Range
ActiveCell.Activate 'au cas où Selection n'est pas un Range
Set r = Intersect(Selection, [J:M], ActiveSheet.UsedRange)
If r Is Nothing Then Exit Sub
lig = Abs(Int(Val(InputBox("Numéro de ligne du collage :"))))
If lig = 0 Then Exit Sub
decal = lig - Selection(1).Row
For Each r In r 'si sélection multiple
    Set dest = r(1, -6).Offset(decal)
    If Not Cells(r.Row, 10).Validation Is Nothing And Not Cells(dest.Row, 3).Validation Is Nothing Then dest = r
Next

Hello TooFatBoy.

 

[TooFatBoy]

Pourtant une action de couper/coller valeurs conserve bien la MEF source et cible?

Non, il est impossible que la cellule de destination ait à la fois la MEF de la source et la MEF de la cible !

 

[mjuju]

Non, il est impossible que la cellule de destination ait à la fois la MEF de la source et la MEF de la cible !

Ha je me suis peut être mal exprimé!
Si je considère M20 comme cellule source avec fond rouge et A2 comme cellule cible en fond bleu
Je veux juste déplacer M20 en A2 mais que la MEF de M20 reste en rouge et A2 reste en bleu

 

[job75]

Les macros du post #11 font du copier-coller.

S'il faut un couper-coller remplacez :

dest = r

par :

dest = r: r = ""

 

[mjuju]

Merci! je vous avoue être perdu...
Je ne comprends pas trop comment faire fonctionner le fichier...
J'ai bien activé les macros à l'ouverture du fichier
Est ce que le macro fonctionne directement?