XL 2013 VBA/ Macro qui classe des données dans une colonne unique

[onyirimba]

Bonjour,

Est ce que je pourrai obtenir une Macro transforme des données en présents en ligne ou non (partie haute de la capture d'écran ci-dessous) dans une colonne unique (partie basse de la capture d'écran ci-dessous).
J'ai joint un fichier Excel explicatif

Merci d'avance de votre aide
Cordialement

 

[fanfan38]

Bonjour
J'envoie les données sur la feuille 2

A+ François

 

[onyirimba]

Bonjour
J'envoie les données sur la feuille 2

A+ François

merci cela fonctionne

 

[sylvanu]

Bonjour onyirimba, fanfan,
Un peu à labour ...
Ou encore en automatique. la macro s'exécute quand on sélectionne la feuille 2.
Le nombre de lignes peut être quelconque, mais les colonnes doivent être de C à N, avec :

Sub Worksheet_Activate()
Dim Tablo, L%, C%, Ligne%
[A:A].ClearContents
Application.ScreenUpdating = False
With Sheets("Feuil1")
    Tablo = .Range("C2:N" & .Cells(.Cells.Rows.Count, "C").End(xlUp).Row)
End With
Ligne = 1
For L = 1 To UBound(Tablo)
    For C = 1 To UBound(Tablo, 2)
        If Tablo(L, C) <> "" Then
            Cells(Ligne, "A") = Tablo(L, C)
            Ligne = Ligne + 1
        End If
    Next C
Next L
End Sub

 

[job75]

Bonjour le forum,

Si l'on veut copier aussi les formats :

Sub Transfert()
Dim dest As Range, c As Range, n&
Application.ScreenUpdating = False
With [C2].CurrentRegion
    Set dest = .Cells(1, .Columns.Count + 2)
    For Each c In .Cells
        If c <> "" Then
            n = n + 1
            c.Copy dest(n)
        End If
    Next
End With
dest.Offset(n).Resize(Rows.Count - n - dest.Row + 1).Clear 'RAZ en dessous
End Sub

A+

 

[onyirimba]

Bonjour le forum,

Si l'on veut copier aussi les formats :

Sub Transfert()
Dim dest As Range, c As Range, n&
Application.ScreenUpdating = False
With [C2].CurrentRegion
    Set dest = .Cells(1, .Columns.Count + 2)
    For Each c In .Cells
        If c <> "" Then
            n = n + 1
            c.Copy dest(n)
        End If
    Next
End With
dest.Offset(n).Resize(Rows.Count - n - dest.Row + 1).Clear 'RAZ en dessous
End Sub

A+

merci