Transposer colonnes multiples en un colonne unique

[lapluchouet]

Bonjour à vous les gens,

J'ai une problématique à vous soumettre...
J'ai un tableau avec un numéro de répondant en colonne A et des réponses en colonnes suivantes (B, C, D, etc.)
Je voudrais n'avoir que deux colonnes : une colonne A avec le n° de répondant et une colonne B avec une réponse (mais ne pas concaténer les réponses dans la même cellule).
A ce jour, je copie et insère devant chaque colonne de réponse (C, D, etc.), la colonne A de n° de répondant, puis je coupe les deux colonnes (Répondant + réponse) et les colle en colonnes A et B, en-dessous des premières réponses.
J'imagine que vous connaissez un moyen plus efficace pour faire cela via une macro... et mes compétences sont assez limitées...
Je joins à mon post, un fichier support...

Merci d'avance à tous :-*

 

[vgendron]

Hello

voici un code à tester et à placer dans un module standard vba (Alt+F11 pour ouvrir l'éditeur)

Sub transpose()
'pour toutes les lignes de la page Etape 1 (qui doit etre active au moment de lancer la macro
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
   'parcourt les 3 colonnes contenant les mots
    For j = 2 To 4
   'créer une feuille ETA4 pour y coller les résultats.. ou changer le nom
        With Sheets("ETA4")
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, 1)
            .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, j)
        End With
    Next j
Next i
End Sub

 

[lapluchouet]

Génial ! ça fonctionne. Merci.

Et aurais-tu un moyen pour que cela reste sur la même feuille, plutôt que d'avoir à en créer une nouvelle ?
Autre question, le "For j= 2 to 4", peut-il être adapté par un nombre de colonnes indéfini ? car il arrive que j'ai davantage de colonnes, et ce n'est pas un nombre fixe.
En tout cas, c'est déjà super. Merci encore.

 

[vgendron]

"For j= 2 to 4", peut-il être adapté par un nombre de colonnes indéfini ?

bien sur, sur le meme principe que pour les lignes

For j = 2 To Range("A1").End(xlToRight).Column

Et aurais-tu un moyen pour que cela reste sur la même feuille,

si tu souhaites mettre dans des colonnes AUTRES que celles qui contiennent les données de départ,
suffit de changer le A et B des lignes suivantes

.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, 1)
.Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, j)

par contre. si tu souhaites écraser les données de départ.. il va falloir modifier le code.. et un peu plus compliqué.

 

[vgendron]

Comme je suis prêt à parier que c'est ce que tu vas demander ;-)

Sub trans()
'récupère le nombre de lignes
nblignes = Range("A" & Rows.Count).End(xlUp).Row
'récupère le nombre de colonnes
NbMots = Range("A1").End(xlToRight).Column

'Recopie des entetes en dessous des données en passant une ligne pour séparer.. pas obligatoire
Range("A1").Resize(1, 2).Copy Destination:=Range("A" & nblignes + 1)

'pour toutes les lignes de la page active
For i = 2 To nblignes
   'parcourt les x colonnes contenant les mots
    For j = 2 To NbMots
   'on colle les data sous les données d'origine
        With ActiveSheet
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, 1)
            .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, j)
        End With
    Next j
Next i
'puis on supprime les données initiales, pour faire remonter les données réorganisées en haut..
Rows(1 & ":" & nblignes).Delete

End Sub

 

[lapluchouet]

Hehe nickel ! merci !
Et si il y a des blancs dans certaines cellules. Tu sais, par exemple, une personne a donné deux mots, une autre trois, une autre un. On peut nettoyer les cellules vides ? (ne pas les rajouter à la suite de mes colonnes A et B)

 

[vgendron]

suffit de mettre un test sur le contenu de la cellule

Sub trans()
'récupère le nombre de lignes
nblignes = Range("A" & Rows.Count).End(xlUp).Row
'récupère le nombre de colonnes
NbMots = Range("A1").End(xlToRight).Column

'Recopie des entetes en dessous des données en passant une ligne pour séparer.. pas obligatoire
Range("A1").Resize(1, 2).Copy Destination:=Range("A" & nblignes + 1)

'pour toutes les lignes de la page active
For i = 2 To nblignes
   'parcourt les x colonnes contenant les mots
    For j = 2 To NbMots
   'on colle les data sous les données d'origine
        If Cells(i, j) <> "" Then
            With ActiveSheet
                .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, 1)
                .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, j)
            End With
        End If
    Next j
Next i
'puis on supprime les données initiales, pour faire remonter les données réorganisées en haut..
Rows(1 & ":" & nblignes).Delete

End Sub

 

[lapluchouet]

C'est parfaitummmmmmmmmm ! Merci beaucoup, beaucoup !!