Le défi: Regrouper des valeurs sur plusieurs lignes en une seule colonne

[worker4you]

Bonjour,
j'ai un peu navigué dans ce forum et je suis séduit par les perspectives des macros.
Je n'y connait pas grand chose mais j'aimerai m'y mettre d'autant plus que j'en ai besoin pour mon travail.

Mon problème est le suivant:
J'ai des infos sur plusieurs lignes du type: 12 0 (vide) 6 12 8
9 3 3 10 8 2
et je voudrai les regrouper dans une seule colonne sur une autre feuille dans une colonne définie en laissant un espace entre chaque série, et de telle manière que les données soient liées. Ce qui donnerai:
12
0
(vide)
6
12
8
(vide)
9
3
etc,...
Ce sera plus claire avec le fichier
(dans le fichier d'origine j'ai environ 500 projets et 30 équipes; le défi ? les valeurs que j'ai grisé sur la feuille 2 doivent se remplir automatiquement d'après les valeurs de la feuille 1)

Qui est prêt à relever ce défi?

Merci d'avance

 

[worker4you]

Re : Le défi: Regrouper des valeurs sur plusieurs lignes en une seule colonne

Voici où j'en suis mais d'une part ça ne saute pas de ligne et d'autre part ça n'efface pas les colonnes de la 1ère macro.


Sub CollerAvecLiaisonTranspose()
Dim PlageSource As Range
Set PlageSource = Worksheets(1).Range("A1:I100")
Dim ocell As Range
For Each ocell In PlageSource
Worksheets(2).Cells(ocell.Column, ocell.Row).Formula = _
"='" & Worksheets(1).Name & "'!" & ocell.Address
Next
End Sub
Sub UneColonne()
Dim c As Long, i As Long
c = ActiveSheet.UsedRange.Columns.Count
For i = 2 To c
Range(Cells(1, i), Cells(1, i).End(xlDown)).Cut Destination:=Range("A65536").End(xlUp)(1)
Next
End Sub

 

[mapomme]

Re : Le défi: Regrouper des valeurs sur plusieurs lignes en une seule colonne

Bonjour,

Une piste:

Sub test()
Dim L, C, K, i, j, F1 As Worksheet, F2 As Worksheet
Set F1 = Worksheets("Feuil1")
Set F2 = Worksheets("Feuil2")

L = F1.Range("A2").End(xlDown).Row
C = F1.Range("B1").End(xlToRight).Column
F2.Range("A:C").ClearContents

For i = 2 To L
    K = K + 1
    F2.Cells(K, 1) = F1.Cells(i, 1)
    For j = 2 To C
        K = K + 1
        F2.Cells(K, 2) = F1.Cells(1, j)
        F2.Cells(K, 3) = F1.Cells(i, j)
    Next j
Next i
End Sub

 

[pierrejean]

Re : Le défi: Regrouper des valeurs sur plusieurs lignes en une seule colonne

Bonjour worker4you

Vois si cela te convient

Edit : on dirait que nous avons les memes sources d'inspiration , mapomme

 

[mapomme]

Re : Le défi: Regrouper des valeurs sur plusieurs lignes en une seule colonne

(re)Bonjour worker4you

Une autre version qui tente de traiter plusieurs tableaux sur la feuille 'Feuil1'(les uns en dessous des autres)
Les explications sont dans le fichier. J'ai essayé de commenter le code.
Regarde la pièce jointe Regrouper des valeurs.xls

 

[worker4you]

Re : Le défi: Regrouper des valeurs sur plusieurs lignes en une seule colonne

Merci beaucoup à vous deux, je test cela de suite et je vous tiens au courant.

 

[worker4you]

Re : Le défi: Regrouper des valeurs sur plusieurs lignes en une seule colonne

Alors finalement j'ai utilisé la formule de mapomme que je comprenais mieux, le résultat est concluant. (Un grand merci bien sûr à pierrejean)
ça m'a aussi permis de me pencher sur le fonctionnement d'une macro et il n'y a pas à dire c'est très efficace.

Au final, la macro adaptée donne ceci:

Sub test()
Dim L, C, K, i, j, F1 As Worksheet, F2 As Worksheet
Set F1 = Worksheets("Sujets 2012 - global")
Set F2 = Worksheets("Résultats mensuel par projet")

L = F1.Range("A3").End(xlDown).Row
C = F1.Range("S2").End(xlToRight).Column
F2.Range("B:M").ClearContents

For i = 3 To L
K = K + 3
F2.Cells(K, 2) = F1.Cells(i, 1)
F2.Cells(K, 9) = F1.Cells(i, 8)
F2.Cells(K, 11) = F1.Cells(i, 10)
F2.Cells(K, 13) = F1.Cells(i, 14)
For j = 19 To C
K = K + 1
F2.Cells(K, 12) = F1.Cells(2, j)
F2.Cells(K, 13) = F1.Cells(i, j)
Next j
Next i
End Sub

j'ai toujours deux questions à tous hasard:
- j'ai un saut de 2 lignes entre chaque projet (à mon avis lié au fait que le libellé de mes équipes commencent en ligne 2), est-il possible de ne plus l'avoir?
- dans ma feuille cible, est'il possible de supprimer des colonnes B à M (ce que fait le script) mais en gardant la première ligne?

Un grand bravo et je vous tiens au courant de mes avancées

 

[worker4you]

Re : Le défi: Regrouper des valeurs sur plusieurs lignes en une seule colonne

Je viens de trouver

Sub test()
Dim L, C, K, i, j, F1 As Worksheet, F2 As Worksheet
Set F1 = Worksheets("Sujets 2012 - global")
Set F2 = Worksheets("Résultats mensuel par projet")

L = F1.Range("A3").End(xlDown).Row
C = F1.Range("S2").End(xlToRight).Column
F2.Range("B3:M10000").ClearContents

For i = 3 To L
K = K + 1
F2.Cells(K + 2, 2) = F1.Cells(i, 1)
F2.Cells(K + 2, 9) = F1.Cells(i, 8)
F2.Cells(K + 2, 11) = F1.Cells(i, 10)
F2.Cells(K + 2, 13) = F1.Cells(i, 14)
For j = 19 To C
K = K + 1
F2.Cells(K + 2, 12) = F1.Cells(2, j)
F2.Cells(K + 2, 13) = F1.Cells(i, j)
F2.Cells(K + 2, 11) = F1.Cells(i, 10)
Next j
Next i
End Sub