Copier automatiquement une colonne horizontale en verticale ss doublon

pie13om

XLDnaute Nouveau
Bonjour à tous,

Mon premier poste sur le forum, je vais essayer d'être le plus clair possible.
J'ai une liste de nom dans une feuille 1 dans la colonne A (sur plus de 10 000 lignes):
Nom1
Nom1
Nom1
Nom2
Nom2
Nom3
Nom4
Nom4
...

Je souhaite obtenir sur une feuille 2 la liste des noms mais à l'horizontal pour faire des tableaux de synthèses:
Nom1 Nom2 Nom3 Nom4 ....

Comme j'ajoute et retire des noms, il faudrait que tout ça se fasse automatiquement... (VBA ??).

J'avais pensé à quelque chose dans ce style:

Sub Test()

i = 2

While Worksheets("Feuille 1").Cells(1, i) <> ""
If Worksheets("Feuille 1").Cells(1, i) <> Worksheets("Feuille 1").Cells(1, i - 1) Then
Worksheets("Feuille 2").Cells(y, 1) = Worksheets("Feuille 1").Cells(1, i - 1)
Else: i = i + 1
End If

End Sub

Mais ça ne marche pas... Quelqu'un peut m'aider ?
Merci pour vos suggéstions.
 

thebenoit59

XLDnaute Accro
Re : Copier automatiquement une colonne horizontale en verticale ss doublon

Bonjour Pie13om.
Bienvenu sur le forum.

Pour l'avenir, essaye d'utiliser les balises
Code:
 quand tu insères une procédure, ça sera plus lisible :).
Une solution possible :

[code]
Sub Transposition_Nom()
Dim i As Long, d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("Feuille1")
For i = 1 To .[a65000].End(xlUp).Row
If .Cells(i, 1).Value <> "" Then d(.Cells(i, 1).Value) = ""
Next i
End With
Sheets("Feuille2").[a1].Resize(1, d.Count).Value = d.keys
End Sub
 

pie13om

XLDnaute Nouveau
Re : Copier automatiquement une colonne horizontale en verticale ss doublon

Merci thebenoit59. C'est niquel !

Y a-t-il un moyen de le faire sans passer par une éxécution de macro (juste en ouvran le fichier...) ?

Merci encore pour ton aide précieuse.
 

thebenoit59

XLDnaute Accro
Re : Copier automatiquement une colonne horizontale en verticale ss doublon

Tu peux intégrer le code dans ThisWorkbook.

Code:
Private Sub Workbook_Open()
Dim i As Long, d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("Feuille1")
For i = 1 To .[a65000].End(xlUp).Row
If .Cells(i, 1).Value <> "" Then d(.Cells(i, 1).Value) = ""
Next i
End With
Sheets("Feuille2").Rows(1).ClearContents
Sheets("Feuille2").[a1].Resize(1, d.Count).Value = d.keys
End Sub
 

pie13om

XLDnaute Nouveau
Re : Copier automatiquement une colonne horizontale en verticale ss doublon

héhé ! Tu peux pas savoir le coup de main que tu viens de me filer !!!
Et alors pour la dernière (et finir en beauté...), si je veux faire la même chose mais copier les noms dans des cellules fusionnées à la suite (pour mettre plusieurs sous colonnes sous chaque nom) ...?
 
Dernière modification par un modérateur:

thebenoit59

XLDnaute Accro
Re : Copier automatiquement une colonne horizontale en verticale ss doublon

Tu peux essayer le code suivant, non testé :

Code:
Private Sub Workbook_Open()
Dim i As Long, d As Object, c As Variant
Set d = CreateObject("scripting.dictionary")
With Sheets("Feuille1")
For i = 1 To .[a65000].End(xlUp).Row
If .Cells(i, 1).Value <> "" Then d(.Cells(i, 1).Value) = ""
Next i
End With
Sheets("Feuille2").Rows(1).ClearContents
i = 1
For Each c In d.keys
Sheets("Feuille2").Cells(1, i) = c
i = i + 2
Next c
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 291
Messages
2 086 849
Membres
103 400
dernier inscrit
MINOU WILL