VBA mettre colonne sous une autre

GalerienneEnVBA Messages postés 5 Date d'inscription   Statut Membre Dernière intervention   -  
 Archer -
Bonjours

J'aimerais une macro qui mettent mes colonne C et D ailles en dessous des colonnes A-B
et ensuite que mes colonnes E et F ailles aussi en dessous

et pareil j'aimerais que qe mes colonnes I-J ailles en dessous des colonnes G-H
et ensuite que mes colonnes K -L aille en dessous aussi.

J'ai lancer : *

Sub deplace()
nbmaxlignes = ActiveSheet.UsedRange.Rows.Count
Range("C2:D" & nbmaxlignes).Copy Destination:=Range("A" & nbmaxlignes + 1)
Range("E2:F" & nbmaxlignes).Copy Destination:=Range("A" & nbmaxlignes * 2 + 1)
Range("C:F").Delete
Range("E2:F" & nbmaxlignes).Copy Destination:=Range("C" & nbmaxlignes + 1)
Range("G2:H" & nbmaxlignes).Copy Destination:=Range("C" & nbmaxlignes * 2 + 1)
Range("E:H").Delete
End Sub


Cependant mes colonnes ne vont pas directement à la suite mais super loin
Si quelqu'un peut m'aider :)
A voir également:

4 réponses

michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
bonjour,

Il faut connaitre pour chaque colonne sa dernière ligne et une fois copier dans la colonne A sa nouvelle dernière ligne

et à la fin supprimer les colonnes B:F



 Michel
0
GalerienneEnVBA Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
Heu ok mais je fais ca comme ahah
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314 > GalerienneEnVBA Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
"ahah", c'est en quelle langue ?
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314 > michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention  
 
tes colonnes ont elles toutes le m^me de lignes et combien de lignes ?
0
GalerienneEnVBA Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
ouais j'ai toujours le meme nombre de ligne mais il change a chaque fois,
la j'en ai 45
0
GalerienneEnVBA Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
Dans mes 12 colonnes j'ai 45 lignes
0
Archer
 
Bonjour
Voila une macro pour le cumul
Sub deplace()
Application.ScreenUpdating = False
' On copie
   Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
   Mlig = Cells(Rows.Count, 3).End(xlUp).Row
      Range("C2:D" & Mlig).Copy Destination:=Range("A" & Nlig)
   Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
   Mlig = Cells(Rows.Count, 5).End(xlUp).Row
      Range("E2:F" & Mlig).Copy Destination:=Range("A" & Nlig)
   Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
   Mlig = Cells(Rows.Count, 7).End(xlUp).Row
      Range("G2:H" & Mlig).Copy Destination:=Range("A" & Nlig)
Application.CutCopyMode = False
' apres on efface
   Range("C:H").Delete
Application.Goto [A1], True
End Sub

a toi de la modifier
A+
Maurice
0
GalerienneEnVBA Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
Ca marche bien j'ai modif pour que ca mettent mette juste les colonnes C et D et colonnes E et F en dessous des colonnes A-B
Mais je fais comment pour que et pareil j'aimerais que qe mes colonnes I-J ailles en dessous des colonnes G-H
et ensuite que mes colonnes K -L aille en dessous aussi.

Sub deplace ()
Application.ScreenUpdating = False
' On copie
Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
Mlig = Cells(Rows.Count, 3).End(xlUp).Row
Range("C2:D" & Mlig).Copy Destination:=Range("A" & Nlig)
Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
Mlig = Cells(Rows.Count, 5).End(xlUp).Row
Range("E2:F" & Mlig).Copy Destination:=Range("A" & Nlig)
Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
Mlig = Cells(Rows.Count, 7).End(xlUp).Row

' apres on efface
Range("C:F").Delete
Application.Goto [A1], True
End Sub
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Option Explicit
'-----------------------------------
Sub empiler()
Dim Nbre As Byte, Ligvid As Integer, Dercol As Byte, Col As Byte, Bloc

Application.ScreenUpdating = False

Nbre = Columns("A").Find("*", , , , , xlPrevious).Row
Dercol = Rows(1).Find("*", , , , , xlPrevious).Column
For Col = 3 To Dercol Step 2
Bloc = Range(Cells(1, Col), Cells(Nbre, Col + 1))
Ligvid = Columns("A").Find("*", , , , , xlPrevious).Row + 1
Cells(Ligvid, "A").Resize(Nbre, 2) = Bloc
Range(Cells(1, Col), Cells(Nbre, Col + 1)).Clear
Next
End Sub

0
Archer
 
Bonjour
tu continue
Sub deplace2()
Application.ScreenUpdating = False
' On copie
   Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
   Mlig = Cells(Rows.Count, 3).End(xlUp).Row
Range("C2:D" & Mlig).Copy Destination:=Range("A" & Nlig)
   Nlig = Cells(Rows.Count, 1).End(xlUp).Row + 1
   Mlig = Cells(Rows.Count, 5).End(xlUp).Row
Range("E2:F" & Mlig).Copy Destination:=Range("A" & Nlig)
   Nlig = Cells(Rows.Count, 7).End(xlUp).Row + 1
   Mlig = Cells(Rows.Count, 9).End(xlUp).Row
Range("I2:J" & Mlig).Copy Destination:=Range("G" & Nlig)
   Nlig = Cells(Rows.Count, 7).End(xlUp).Row + 1
   Mlig = Cells(Rows.Count, 11).End(xlUp).Row
Range("K2:L" & Mlig).Copy Destination:=Range("G" & Nlig)

Application.CutCopyMode = False

' apres on efface
   Range("C:F,I:L").Delete
Application.Goto [A1], True
End Sub

A+
Maurice
0