Recopier les cellules d'une plage dans une colonne unique

sedna

XLDnaute Nouveau
Bonjour,

Je voudrais, à partir d'une plage de données (4 colonnes, 100 lignes), recopier les données (susceptibles de changer régulièrement, la recopie doit donc être automatique) dans une seule colonne (de 400 cellules donc).

Je vous ai mis un exemple en pièce jointe pour mieux comprendre.

Merci d'avance.

Sedna
 

Pièces jointes

  • Classeur1.xlsx
    9.5 KB · Affichages: 48
  • Classeur1.xlsx
    9.5 KB · Affichages: 46
  • Classeur1.xlsx
    9.5 KB · Affichages: 38

Cousinhub

XLDnaute Barbatruc
Re : Recopier les cellules d'une plage dans une colonne unique

Bonjour,

Essaie avec ce code :

Code:
Option Base 1
Sub recap()
Dim Tblo1
Dim Plg As Range
Dim I As Long, K As Long
Dim J As Byte
Set Plg = Range("C5:F" & Cells(Rows.Count, "C").End(xlUp).Row)
Tblo1 = Plg
ReDim Tblo2(Application.CountA(Plg))
K = 1
For I = LBound(Tblo1) To UBound(Tblo1)
    For J = 1 To 4
        Tblo2(K) = Tblo1(I, J): K = K + 1
    Next J
Next I
Range("I5").Resize(UBound(Tblo2)) = Application.Transpose(Tblo2)
End Sub

Bon W-E
 

Cousinhub

XLDnaute Barbatruc
Re : Recopier les cellules d'une plage dans une colonne unique

Re-,

si toutes les cellules ne sont pas remplies, tu peux modifier le code ainsi :

Code:
Option Base 1
Sub recap()
Dim Tblo1
Dim Plg As Range
Dim I As Long, K As Long
Dim J As Byte
Set Plg = Range("C5:F" & Cells(Rows.Count, "C").End(xlUp).Row)
Tblo1 = Plg
ReDim Tblo2(Application.CountA(Plg.SpecialCells(xlCellTypeConstants, 23)))
K = 1
For I = LBound(Tblo1) To UBound(Tblo1)
    For J = 1 To 4
        If Tblo1(I, J) <> "" Then Tblo2(K) = Tblo1(I, J): K = K + 1
    Next J
Next I
Range("I5").Resize(UBound(Tblo2)) = Application.Transpose(Tblo2)
End Sub

Bon courage
 

R@chid

XLDnaute Barbatruc
Re : Recopier les cellules d'une plage dans une colonne unique

Bonjour @ tous,
Par formules,

Si les valeurs sont numériques, en H5,
Code:
=SIERREUR(PETITE.VALEUR(C$5:F$18;LIGNES($5:5));"")
@ tirer vers le bas


Si les valeurs sont des textes, en H5,
Code:
=DECALER(C$5;ENT((LIGNES($5:5)-1)/COLONNES(C:F));MOD(LIGNES($5:5)-1;COLONNES(C:F)))&""
@ tirer vers le bas


@ + +
 

Staple1600

XLDnaute Barbatruc
Re : Recopier les cellules d'une plage dans une colonne unique

Bonjour à tous, re sedna

Comme j'ai pondu, je poste ;)
(salut les aminches ;)
Code:
Sub MacroSedna()
Dim Plg As Range, Dlig&, i&
Dlig = Range("C" & Rows.Count).End(3).Row
[H4] = "'"
For i = 5 To Dlig
    Set Plg = Range("C" & i, "F" & i)
    Range("H" & Rows.Count).End(3)(2).Resize(Plg.Count) = _
    Application.WorksheetFunction.Transpose(Plg)
Next i
End Sub
 

laetitia90

XLDnaute Barbatruc
Re : Recopier les cellules d'une plage dans une colonne unique

bonjour sedna , bhbh :),R@chid :), JM :)

du simple :p

Code:
Dim c As Range
 For Each c In Range("c5:f" & Cells.Find("*", , , , , xlPrevious).Row)
 If c <> "" Then Cells(Rows.Count, 8).End(3)(2) = c
 Next
 

job75

XLDnaute Barbatruc
Re : Recopier les cellules d'une plage dans une colonne unique

Bonjour à tous,

Avec un maximum de 400 cellules pas besoin de se casser la tête !

Code:
Sub Copie()
Dim o As Range, dest As Range, n As Long
Set o = [C5:F104]: Set dest = [H5] 'à adapter
For Each o In o
  If o <> "" Then n = n + 1: dest(n) = o
Next
dest(n + 1).Resize(Rows.Count - dest(n).Row).ClearContents
End Sub
A+
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Recopier les cellules d'une plage dans une colonne unique

Re à tous


leti:
Tu permets que je fasse mumuse ;)
Code:
Sub PourLeFun()
Dim c As Range
For Each c In Range("c5:f" & Cells.Find("*", , , , , xlPrevious).Row)
Cells(Rows.Count, 8).End(3)(2) = c.Offset(1 + (c <> ""), 0)
Next
End Sub

bhbh
Je peux crételer si tu veux mais vous entendrez pas grand chose ;) d'où vous êtes.
 

Cousinhub

XLDnaute Barbatruc
Re : Recopier les cellules d'une plage dans une colonne unique

Hi, J-M

T'as vu, même sur France 2, ils savent pas écrire "Rennes", ils mettent "Roazhon"...........Comme toi....

Nous, c'est même pas dur, c'est "Brest mêm!"

allez les Broks
 

Discussions similaires

Statistiques des forums

Discussions
312 559
Messages
2 089 600
Membres
104 221
dernier inscrit
legendking85