Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Mettre plusieurs colonnes en ligne de manière automatique

babuche

XLDnaute Nouveau
Bonjour tout le monde,

J'aurais besoin de votre aide.

J'ai créé un questionnaire concernant une campagne d'emploi.
Concrètement, 1 direction peut demander jusqu'à 15 postes et pour chacun des postes il y a en tout 12 questions. Bien entendu, pour la 1ère demande les variables se nomment par ex. "corps1" et la 2ème demande "corps2" etc, les 180 différentes variables portent donc des noms différents.
Lorsque je fais l'extraction des réponses à ce formulaire, j'obtiens une ligne pour 1 direction avec les 12 colonnes pour chacun des postes.

Mais la DRH ne souhaite pas ce format, elle souhaite 1 ligne par demande de poste, donc potentiellement 15 lignes par structures (mais cela peut être 1 ou 2 lignes par entité, avec des noms de colonnes différents).
Il faudrait donc mettre les différentes colonnes en lignes de manière automatisées, avec par ex. la réponse à "corps2" dans la même colonne que la réponse à "corps1".
Bien entendu la base évolue chaque semaine, il faudrait donc une formule ou une macro qui s'actualiserait très facilement.

J'ai essayé de faire des tableaux croisés dynamiques puis avec Power Query d'assembler les différents tableaux ensemble. Seulement même si j'ai Excel 2016, au sein de la DRH tout le monde n'a pas cette version et j'ai peur qu'il y ait des incompatibilités.
Et je ne m'y connais pas très bien en macro, j'aimerai donc votre aide.

Voici pour vous donner un exemple la feuille Excel de test : le tableur provenant du questionnaire serait déposé via copier-coller sur l'onglet "base a copier ici" et le résultat souhaité au final se trouverait dans l'onglet "tableau final".

Je sais que c'est pas très clair, si vous avez besoin d'autres renseignements, n'hésitez pas à me demander.
Merci d'avance pour votre aide.
Bien cordialement.
 

Pièces jointes

  • Fichier TEST campagne emploi.xlsx
    23.8 KB · Affichages: 12

job75

XLDnaute Barbatruc
Bonjour babuche, bienvenue sur XLD,

Je pense avoir compris, alors voyez le fichier joint et cette macro :
VB:
Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, j%, k%, x$
tablo = Feuil1.[A1].CurrentRegion.Resize(, 182) '182 = 2 + 15 x 12
ReDim resu(1 To UBound(tablo), 1 To 14) '14 = 2 + 1 x 12)
For i = 2 To UBound(tablo)
    resu(i - 1, 1) = tablo(i, 1): resu(i - 1, 2) = tablo(i, 2)
    For j = 3 To 182 Step 12
        If tablo(i, j) <> "" Then
            For k = 0 To 11
                x = resu(i - 1, 3 + k)
                resu(i - 1, 3 + k) = IIf(x = "", "", x & vbLf) & tablo(i, j + k)
            Next
        End If
Next j, i
'---restitution---
If i > 2 Then [A2].Resize(i - 2, 14) = resu
Rows(i & ":" & Rows.Count).Delete 'RAZ en dessous
End Sub
Elle est à placer dans le code de la feuille "Tableau final" et se déclenche quand on active cette feuille.

A+
 

Pièces jointes

  • Fichier TEST campagne emploi(1).xlsm
    34.6 KB · Affichages: 9

babuche

XLDnaute Nouveau
Bonjour job75.

Je me rends compte que j'ai oublié de vous remercier pour votre aide.
Merci beaucoup pour ce que vous avez fait.

J'aurai désormais une autre demande : dans le fichier que vous avez créé, est-ce qu'il serait possible au lien des retours chariots d'avoir une nouvelle ligne ? Ainsi, à la place d'avoir 1 lignes pour 15 demandes est-ce qu'il serait possible d'avoir 15 lignes ?

Merci d'avance pour votre aide et encore un grand merci pour le 1er fichier qui nous a beaucoup aidé.

A+
 

job75

XLDnaute Barbatruc
Bonjour babuche,

J'ai hésité à vous répondre car je n'aime pas les rigolos qui ne disent même pas merci quand on donne une solution.

Mais bon, vous êtes nouveau, voyez ce fichier (2) et la macro :
VB:
Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, j%, n&, k%
tablo = Feuil1.[A1].CurrentRegion.Resize(, 182) '182 = 2 + 15 x 12
ReDim resu(1 To 15 * UBound(tablo), 1 To 14) '14 = 2 + 1 x 12)
For i = 2 To UBound(tablo)
    For j = 3 To 182 Step 12
        n = n + 1
        resu(n, 1) = tablo(i, 1): resu(n, 2) = tablo(i, 2)
        If tablo(i, j) <> "" Then
            For k = 0 To 11
                resu(n, 3 + k) = tablo(i, j + k)
            Next
        End If
Next j, i
'---restitution---
If n Then [A2].Resize(n, 14) = resu
Rows(n + 2 & ":" & Rows.Count).Delete 'RAZ en dessous
End Sub
 

Pièces jointes

  • Fichier TEST campagne emploi(2).xlsm
    32.5 KB · Affichages: 4

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…