VBA mettre colonne sous une autre
GalerienneEnVBA
Messages postés
6
Statut
Membre
-
Archer -
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 :)
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 :)
4 réponses
-
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 -
Bonjour
Voila une macro pour le cumulSub 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-
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
-
-
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
-
Bonjour
tu continueSub 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
