Réorganiser un fichier - nombre de colonne variable

Bonsoir,

J'avance dans mon fichier, l'étape suivante je ne vois pas par où prendre la chose...

Je dois réorganiser mon fichier :

En haut j'ai des dates, mais mon export me "splite" les données sur plusieurs colonnes pour chaque journée (mais bien entendu pas le même nombre de colonne pour chaque date), je voudrais donc réunir ces données, en deux colonnes pour chaque date (car j'ai une donnée pour le matin et une autre pour l'après-midi, s'il y a deux données pour la même date elles sont donc toutes les 2 à conserver côté à côte)

Ca sera plus parlant avec le fichier ci-joint ;)

Franchement si vous y arrivez vous êtes fortiches !

D'avance bonne soirée à tous

Bonjour,

Un test fonctionnel (et qui m'a fait perdre les cheveux ...) avec le jeu de données fourni et la structure :

Sub NET()
Dim C&, LC&, C_F&, C_I&, LR&
With Worksheets("A")
    LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    C_F = LC
    For C = LC To 2 Step -1
        If .Cells(1, C) = .Cells(1, C).Offset(, -1) Then
            C_I = C_I + 1
            Else
            C_I = C_F - C_I
            C_F = C_F + 1
            .Cells(1, C_I).Offset(, 2).Resize(1, C_F - C_I - 2).ClearContents
                For L = 2 To LR
                    If .Cells(L, C_I) = "" And .Cells(L, C_I).End(xlToRight).Column < C_F Then
                        .Cells(L, C_I) = .Cells(L, C_I).End(xlToRight)
                        .Cells(L, C_I).End(xlToRight).ClearContents
                        ElseIf .Cells(L, C_I) <> "" And .Cells(L, C_I).Offset(, 1).End(xlToRight).Column < C_F Then
                        .Cells(L, C_I).Offset(, 1) = .Cells(L, C_I).End(xlToRight)
                        .Cells(L, C_I).Offset(, 1).End(xlToRight).ClearContents
                    End If
                Next L
            .Cells(1, C_I).Offset(, 2).Resize(1, C_F - C_I - 2).EntireColumn.Delete
            C_F = C - 1
            C_I = 0
        End If
    Next C
End With
End Sub

Cdlt,

PS : Il y a peut être plus simple mais ça ne m'est pas venu à l'esprit désolé.

Salut Lorence,
Salut Ergotamine,

autre façon qui, sauf erreur ou incompréhension du problème, donne même des résultats plus complets que l'exemple de Lorence...
Un double-clic sur la feuille démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tExtract(), iCol%, iIdx%, vTab
'
tTab = Range("A1").Resize(Range("A" & Rows.Count).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column + 1).Value
vTab = tTab(1, 2)
iCol = 2
'
For x = iCol To UBound(tTab, 2)
    If tTab(1, x) <> vTab Then
        iIdx = IIf(iCol = 2, 3, iIdx + 2)
        ReDim Preserve tExtract(UBound(tTab, 1), iIdx)
        For y = 2 To UBound(tTab, 1)
            If iCol = 2 Then tExtract(y - 1, 0) = tTab(y, 1)
            tExtract(0, iIdx - 2) = Format(vTab, "dddd d mmmm yyyy")
            tExtract(0, iIdx - 1) = Format(vTab, "dddd d mmmm yyyy")
            For Z = iCol To x - 1
                If tTab(y, Z) <> "" Then tExtract(y - 1, iIdx - IIf(tExtract(y - 1, iIdx - 2) = "", 2, 1)) = tTab(y, Z)
            Next
        Next
        iCol = x
        vTab = tTab(1, x)
    End If
Next
'
Range("A20").Resize(UBound(tTab, 1), UBound(tExtract, 2)).Value = tExtract
'
End Sub

A+

Merci beaucoup ça fonctionne nickel !

Vous êtes vraiment des as ;) Merci