Regrouper Colonnes en 1 sans Les cellules vides

[Amigo]

Bonsoir le Forum,
D'abord Bonne et heureuse Année 2011 à vous tous et tous les êtres qui vous sont chers…
Je viens solliciter votre aide.
Je souhaite regrouper des colonnes en 1 seul sans les cellules vides. Tout est dans le fichier joint.
Merci par avance
Amigo

 

[Softmama]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour Amigo,

Cette macro devrait t'aider :

Sub gozyva()
Dim c As Range, t&
t = 2
Set c = Range("A2")
Do While c <> ""
    Do While c <> ""
        Cells(t, 15) = c
        Set c = c(2, 1)
        t = t + 1
    Loop
    Set c = Cells(2, c.Column + 1)
Loop
End Sub

cf. Fichier joint en retour.

 

[JCGL]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour à tous,

Peux-tu essayer ce code de Papou :

Option Explicit

Sub Extraction()    ' Papou-Net sur XLD
    Dim Cel As Range
    Dim Val As Range

    Range("N2" & Range("N65536").End(xlUp).Row).ClearContents
    For Each Cel In Range("A2:L26").SpecialCells(xlCellTypeFormulas, 23)
        Set Val = Range("N:N").Find(Cel.Value, LookIn:=xlValues)
        If Val Is Nothing Then Range("N" & Range("N65536").End(xlUp).Row + 1) = Cel.Value
    Next
    Columns("N:N").Sort Key1:=Range("N1"), Order1:=xlAscending, Header:=xlGuess
    Range("N1").Select
End Sub

A+ à tous

Édition : je viens de lire que les valeurs sont issues de formules... Code modifié...

 

[mprexcel]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour Amigo,
Meilleurs voeux à toi et à tes proches également.
Sur base de quoi veux-tu affiché la colonne O au lieu de la colonne N vide?
Cordialement,
Michel

 

[Amigo]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonsoir Softmama, JCGL, mprexcel, le forum
Merci pour vos réponses
@Softmama : ca fonctionne. Merci
@JCGL : le résultat n'est pas bon car il me donne après le 17, 47, 69, 96 au lieu de 17, 26, 27 ...
@mprexcel : le regroupement devrait se faire en colonne N ou O n'importe.
Merci par avance
Amigo

 

[Amigo]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Re:
@JCGL : suite à ton "EDIT" j'ai effectué la modif de la macro mais j'ai un code errreur 1004 sur la ligne

For Each Cel In Range("A2:L26").SpecialCells(xlCellTypeFormulas, 23)

Y aura-t-il un moyen que le resultat se met à jour à chaque changement si une formule des cellules vides me retourne une valeur?
Merci par avance
Cordialement
Amigo

 

[Efgé]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour amigo, Softmama, JC ; )
Juste pour le plaisir de participer... Je pense que c'est plus rapide

Sub test()
Dim Tablo(), Col%, c As Range, Plg, i&, LstRw&
With Sheets("Res")
    For Col = 1 To 12
        Set Plg = .Range(Cells(2, Col), .Cells(Rows.Count, Col).End(xlUp))
        LstRw = LstRw + Plg.Rows.Count
        ReDim Preserve Tablo(1 To LstRw + Plg.Rows.Count)
        For Each c In Plg
            If c.Value <> "" Then
                i = i + 1
                Tablo(i) = c.Value
            End If
        Next c
    Next Col
    .Cells(2, 14).Resize(UBound(Tablo)) = Application.Transpose(Tablo)
End With
End Sub

Cordialement

EDIT problèmes de balise (Grrr)
EDIT2 En prévisualisation c'est bon mais ...

 

[JCGL]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour à tous,
Salut FG,

Pour aider FG ... Arf Arf

Sub Test()

Dim Tablo(), Col%, c As Range, Plg, i&, LstRw&
With Sheets("Res")
 For Col = 1 To 12
 Set Plg = .Range(Cells(2, Col), .Cells(Rows.Count, Col).End(xlUp))
 LstRw = LstRw + Plg.Rows.Count
 ReDim Preserve Tablo(1 To LstRw + Plg.Rows.Count)
 For Each c In Plg
 If c.Value <> "" Then
 i = i + 1
 Tablo(i) = c.Value
 End If
 Next c
 Next Col
 .Cells(2, 14).Resize(UBound(Tablo)) = Application.Transpose(Tablo)
End With
End Sub

 

[Efgé]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour à tous,
Salut FG,

Pour aider FG ... Arf Arf

Sub Test()

Dim Tablo(), Col%, c As Range, Plg, i&, LstRw&
With Sheets("Res")
For Col = 1 To 12
Set Plg = .Range(Cells(2, Col), .Cells(Rows.Count, Col).End(xlUp))
LstRw = LstRw + Plg.Rows.Count
ReDim Preserve Tablo(1 To LstRw + Plg.Rows.Count)
For Each c In Plg
If c.Value <> "" Then
i = i + 1
Tablo(i) = c.Value
End If
Next c
Next Col
.Cells(2, 14).Resize(UBound(Tablo)) = Application.Transpose(Tablo)
End With
End Sub

Je vois que je ne suis pas seul dans le cas Arf.... )

 

[Amigo]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonsoir à vous tous
Merci Efgé pour ta réponse
Merci JCGL ca fonctionne
Permettez-moi de reposer la question en poste #6
"Y aura-t-il un moyen que le resultat se met à jour à chaque changement si une formule des cellules vides me retourne une valeur?"
car mes données peuvent changer.
Merci par avance
Cordialement
Amigo

 

[Softmama]

Re : Regrouper Colonnes en 1 sans Les cellules vides

re amigo,

pour la réponse que je t'ai faite, tu peux copier cette macro dans le module de ta feuille Res :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A2:L26"), Target) Is Nothing Then
        gozyva
    End If
End Sub

 

[Amigo]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Re, tout le monde
Merci Softmama ca fonctionne...
Cordialement
Amigo

 

[Amigo]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour, Softmama, JCGL, Efgé, mprexcel, le Forum
D'abord Mea culpa, dans le fichier exemple joint dans le poste précedent j'ai mis des chiffres au lieu des dates,Désolé.
Je me suis rejouis trop vite. en appliquant les macros sur mon fichier original, quelques erreurs trouvées.
1- Macro Softmama fonctionne par contre très lente au calcul et quand je change sur la feuille 1 en mettant des OFF au lieu des M ou N
(ex dans "Feuil1!A1 ou A2") le changement par les formules Feuil!2 s'effectue mais pas dans la colonne N

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A2:L26"), Target) Is Nothing Then
gozyva
End If
End Sub

2- Macro JCGL & Efgé fonctionne très bien a part qu'elle copie les dates en format "mm/dd/yyyy" les valeurs des jours < 13 voir colonne "O" Feuil2

Merci par avance
Cordialement
Amigo

 

[JCGL]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour à tous,

Peux-tu essayer avec :

Sub Test()
Dim Tablo(), Col%, c As Range, Plg, i&, LstRw&
With Sheets("Feuil2")
For Col = 1 To 12
Set Plg = .Range(Cells(2, Col), .Cells(Rows.Count, Col).End(xlUp))
LstRw = LstRw + Plg.Rows.Count
ReDim Preserve Tablo(1 To LstRw + Plg.Rows.Count)
For Each c In Plg
If c.Value <> "" Then
i = i + 1
Tablo(i) = c.Value * 1
End If
Next c
Next Col
.Cells(2, 15).Resize(UBound(Tablo)) = Application.Transpose(Tablo)
End With
Columns("O:O").NumberFormat = "dd/mm/yyyy"
Range("O1").Select
End Sub

A+ à tous

 

[Efgé]

Re : Regrouper Colonnes en 1 sans Les cellules vides

Bonjour à tous,
J'alais proposer:

Sub Test()
Dim Tablo(), Col%, c As Range, Plg, i&, LstRw&
With Sheets("Feuil2")
    For Col = 1 To 12
        Set Plg = .Range(Cells(2, Col), .Cells(Rows.Count, Col).End(xlUp))
        LstRw = LstRw + Plg.Rows.Count
        ReDim Preserve Tablo(1 To LstRw)
        For Each c In Plg
            If c.Value <> "" Then
                i = i + 1
                Tablo(i) = Format(c.Value, "m/d/yyyy")
            End If
        Next c
    Next Col
    .Cells(2, 16).Resize(UBound(Tablo)) = Application.Transpose(Tablo)
End With
End Sub

Mais la solution de JC va aussis ; )
Cordialement