Scinder unligne Excel en plusieurs lignes

Bonjour,

J'ai une feuille Excel avec liste nominative et les différents éléments variables du mois (heures travaillés, heures supp faites, congés pris, absences diverses, indemnités, etc. ). Une ligne d'entête descriptive décrit les différents champs.

Je voudrais pour chaque personne obtenir une ligne avec chaque données variable du mois.

Ainsi pour avec la ligne entête : | Mois|Nom|Prénom|Matricule|Heures travaillées|heures supp. 125% |heures supp. 150%|heures congés pris|etc.

et la ligne de données: |Janvier|Durand | Paul| 000001| 154|10|12|8|...

Je souhaiterais obtenir plusieurs lignes :

|Janvier|Durand | Paul| 000001|Heures travaillées|157

|Janvier|Durand | Paul| 000001| Heures supps. 125%|10

|Janvier|Durand | Paul| 000001| Heures supps 150%|12

|Janvier|Durand | Paul| 000001| Heures congés pris|8

et la même chose pour toutes les lignes du tableau initial.

Je pensais initialement le faire avec un tableau croisé dynamique mais je maitrise mal et n'y arrive pas.

Merci de votre aide.

Thierry

Bonjour,

Il est toujours préférable d'ajouter un petit fichier d'exemple (avec données non confidentielles) et de même présentation que l'original, ça aide

Bonjour

Difficile sans fichier.... mais

1) coller ton extraction en colonne A à partir de 1 et sélectionner la colonne

2) menu Données ==> outil convertir

1ere fenêtre cliquer sur délimiteé puis suivant

2 ème : cliquer sur Autres et saisir dans la cellule correspondante | (Alt gras 6)

puis suivant

La cellule est découpée en 6 colonnes et on peut en faire ce que l'on veut

Question: le nb de lignes est il constant ?

Dans l'attente

Cordialement

FINDRH

Bonsoir à tous,

Tes données dans la 1ère feuille de ton classeur à partir de A1, avec une ligne d'en-têtes

Restitution dans la 2ème feuille de ton classeur.

Option Explicit

Sub test()
Dim a, b(), i As Long, j As Long, n As Long
    Application.ScreenUpdating = False
    a = Sheets(1).Range("a1").CurrentRegion.Value
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 4) + 1, 1 To 6)
    b(1, 1) = "Mois": b(1, 2) = "Nom": b(1, 3) = "Prénom"
    b(1, 4) = "Matricule": b(1, 5) = "Heures": b(1, 6) = "Nombre"
    n = 1
    For i = 2 To UBound(a, 1)
        For j = 5 To UBound(a, 2)
            n = n + 1
            b(n, 1) = a(i, 1): b(n, 2) = a(i, 2)
            b(n, 3) = a(i, 3): b(n, 4) = a(i, 4)
            b(n, 5) = a(1, j): b(n, 6) = a(i, j)
        Next
    Next
    'Restitution en Feuil2
    With Sheets(2)
        .Cells.Clear
        With .Cells(1).Resize(n, 6)
            .Value = b
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 44
            End With
            .Font.Name = "calibri"
            .Font.Size = 10
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            .Columns.AutoFit
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89