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.
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
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
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
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
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.