Discussion :

[ericdev67]

Bonjour,

J'aimerai mettre un tableau sous forme de colonnes....

Suite à la lecture des supers tutos de JB (Regroupement avec présentation en colonnes), JB, propose une de mettre des colonnes sous forme de tableau....je cherche à faire exactement l'inverse....mais je n'arrive pas à "modifier" le code...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub PrésentationColonnes()
  [D2:K100].ClearContents
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range("A2:A" & [A65000].End(xlUp).Row)
    d(c.Value) = d(c.Value) & c.Offset(0, 1) & "|"
  Next c
  If d.Count > 0 Then
    [d2].Resize(, d.Count) = d.keys
    i = 0
    For Each c In d.items
       a = Split(c, "|")
       d4].Offset(, i).Resize(UBound(a)) = Application.Transpose(a)
       i = i + 1
    Next c
  End If
End Sub

pour y arriver....
Ce que je cherche à avoir :


Merci pour votre aide,

[unparia]

Bonjour
Et pourquoi passer par l'utilisation d'un objet dictionary ?
Qu'est-ce que c'est que cette histoire ?
Intéresse-toi vite à la méthode RangeCopy (rubrique Range.Copy, méthode de ton aide VBA interne !)

[ericdev67]

Merci unparia,

En fait, je cherche souvent l'inspiration et/ou repris les codes de JB, me permettant d'évoluer avec Excel....donc comme j'ai vu ce code (via Dictionary, certes et j'ai pu voir que Dictionay est très rapide) j'essaye de le "remanier", mais sans succès...

Maintenant s'il y a d'autres possibilités, je suis preneur...

Je suis allé sur F2 Range.copy, mais je ne vois pas comment faire, surtout qu'il faut que je reprenne la colonne des Noms à chaque fois....une petite piste ?

Merci pour votre aide,

[unparia]

Je suis allé sur F2 Range.copy, mais je ne vois pas comment faire, surtout qu'il faut que je reprenne la colonne des Noms à chaque fois....une petite piste ?

Tu plaisantes ?
C'est d'une simplicité déconcertante !
Montre-moi ce que tu as au moins tenté sur cette base.

[ericdev67]

Merci unparia,

Tout n'est pas simple pour moi....
j'ai fait, pour essai :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub es()
Worksheets("Planning").Range("A2:D11").Copy _
    Destination:=Worksheets("Planning").Range("J2")
End Sub

Mon planning va jusqu'à AE11 (Lundi à vendredi matin et aprem), et je ne vois pas comment "récupérer" la colonne A....pour les mardis, mercredis, etc....

Mon pour ton aide,

[unparia]

Tout n'est pas simple pour moi....

Vraiment, là ...
Je pense que tu as mal choisi ta voie.
Ce n'est là qu'une question de bon sens et de logique !
Regarde (et je suis un "vieux crouton"):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
derlig = Range("A" & Rows.Count).End(xlUp).Row
Range(Cells(1, 1), Cells(derlig, 4)).Copy Destination:=Range("J1")
Range(Cells(2, 1), Cells(derlig, 1)).Copy Destination:=Range("J" & derlig + 1)
Range(Cells(2, 5), Cells(derlig, 7)).Copy Destination:=Range("k" & derlig + 1)

[boisgontierjacques]

bONSOIR?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub TransformeBD()
  Set f = Sheets("bd")
  Set Rng1 = Range("a1:d" & f.[A65000].End(xlUp).Row)
  Set dest = f.[j1]
  Rng1.Copy dest
  Set Rng2 = Range("e2:g" & f.[A65000].End(xlUp).Row)
  n = [A65000].End(xlUp).Row - 1
  Rng2.Copy dest.Offset(n + 1, 1)
  Set Rng3 = Range("a2:a" & f.[A65000].End(xlUp).Row)
  Rng3.Copy dest.Offset(n + 1)
End Sub

Boisgontier

[ericdev67]

Bonsoir unparia,

Je pense avoir compris....
essai avec rajout Mardi Matin :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Range(Cells(1, 1), Cells(Range("A" & Rows.Count).End(xlUp).Row, 4)).Copy Destination:=Range("T1") 'LM
Range(Cells(2, 1), Cells(Range("A" & Rows.Count).End(xlUp).Row, 1)).Copy Destination:=Range("T" & Range("A" & Rows.Count).End(xlUp).Row + 1) 'copie des noms
Range(Cells(2, 5), Cells(Range("A" & Rows.Count).End(xlUp).Row, 7)).Copy Destination:=Range("U" & Range("A" & Rows.Count).End(xlUp).Row + 1) 'LA
Range(Cells(2, 8), Cells(Range("U" & Rows.Count).End(xlUp).Row, 10)).Copy Destination:=Range("U" & Range("T" & Rows.Count).End(xlUp).Row + 1) 'MM
Range(Cells(2, 1), Cells(Range("A" & Rows.Count).End(xlUp).Row, 1)).Copy Destination:=Range("T" & Range("T" & Rows.Count).End(xlUp).Row + 1) 'recopie des noms

Merci pour ce code et piste...grâce à toi, j'ai ma solution...


Bonsoir JB,

Merci pour ce code, j'ai essayé de le reproduire (puisque j'ai de lundi à vendredi, matin et aprem), mais ...cela ne fonctionne pas....(enfin, je sais que c'est moi qui fait une erreur, mais je n'arrive pas à la trouver...)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub TransformeBD()
  Set f = Sheets("bd") 'identificatio feuille
  Set LM = Range("a1:d" & f.[A65000].End(xlUp).Row) 'Lundi Matin
  Set dest = f.[T1] 'positionnement en T pour la destination
  LM.Copy dest
  Set LA = Range("e2:g" & f.[A65000].End(xlUp).Row) 'lundi aprem
  n = [A65000].End(xlUp).Row - 1
  LA.Copy dest.Offset(n + 1, 1) 'dernière ligne occupée sur J
  Set listenom = Range("a2:a" & f.[A65000].End(xlUp).Row) 'identification Noms
  listenom.Copy dest.Offset(n + 1) 'recopie des noms à la suite de T
 
 
 Set MM = Range("H2:J" & f.[A65000].End(xlUp).Row)
MM.Copy dest.Offset(n + 1)
 
End Sub

(pour essayer, j'ai juste rajouté le mardi matin, et essayé de le mettre à la suite...(en colonne T, pour essayer...)

Merci pour votre aide,