Copie de colonnes les unes en dessous des autres
P
Bonjour,
J'ai des tableaux avec un nombre variable de colonnes et je souhaite tout mettre sous une seule colonne
Le problème c'est que je ne connais pas à l'avance le nombre de colonnes initiales.
En fait je voudrais partir de la colonne A jusqu'à la dernière colonne contenant des données.
Je dois impérativement n'avoir à la fin qu'une seule colonne.
Je joints un fichier en exemple.
J'ai des tableaux avec un nombre variable de colonnes et je souhaite tout mettre sous une seule colonne
Le problème c'est que je ne connais pas à l'avance le nombre de colonnes initiales.
En fait je voudrais partir de la colonne A jusqu'à la dernière colonne contenant des données.
Je dois impérativement n'avoir à la fin qu'une seule colonne.
Je joints un fichier en exemple.
f
E
Bonjour,
A tester :
Sub Test()
Dim I As Integer, J As Integer, DerniereColonne As Integer, DerniereLigne As Integer, LigneEnCours As Integer
Dim Sh As Worksheet
Set Sh = ActiveSheet
With Sh
DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
LigneEnCours = DerniereLigne + 1
DerniereColonne = .Cells.SpecialCells(xlCellTypeLastCell).Column
For J = 2 To DerniereColonne
DerniereLigne = .Cells(.Rows.Count, J).End(xlUp).Row
For I = 1 To DerniereLigne
If .Cells(I, J) <> "" Then
.Cells(LigneEnCours, 1) = .Cells(I, J)
LigneEnCours = LigneEnCours + 1
End If
Next I
.Cells(1, J).EntireColumn.Clear
Next J
End With
Set Sh = Nothing
End SubBonjour à tous,
Une variante....à tester...
Option Explicit
Option Base 1
Sub tb_1colonne()
Dim lig&, col%, index&, dc%, dl&
Dim Tb, TbR()
With Sheets("Feuil1") '...............................................agit sur Feuil1
dc = .UsedRange.Columns.Count '....................................définit nombre de colonnes
dl = .UsedRange.Rows.Count '.......................................définit nombre de lignes
Tb = .Range(.Cells(1, 1), .Cells(dl, dc)) '........................définit tableau de données Tb
ReDim TbR(UBound(Tb) * dc) '......................................dimensionne le tableau temporaire TbR
index = 1
For col = 1 To dc '.............................................boucle de la 1ère à la dernière colonne du tableau Tb
For lig = 1 To UBound(Tb) '.....................................boucle de la 1ère à la dernière ligne du tableau TB
If Tb(lig, col) <> "" Then '...................................si la cellule est remplie
TbR(index) = Tb(lig, col) '..................................on stocke la valeur dans TbR
index = index + 1 '..........................................incrémente l'index
End If '.......................................................fin de la condition
Next lig '......................................................ligne suivante
Next col '.......................................................colonne suivante
.Cells.ClearContents '...............................................efface les données
.Columns(1).HorizontalAlignment = xlCenter '.........................texte centré
.Range("A1").Resize(UBound(TbR), 1) = Application.Transpose(TbR) '...écrit les données de TbR à partir de A1
End With
End SubCTRL + e pour exécuter la macro...
Cordialement,
P
Bonjour à tous,
Merci pour les réponses, grâce à vous le problème est résolu.