Transposer des blocs à la chaine

Hello,

Sur l'onglet "Data Brutes" j'ai rapatrié des blocs de données délimités entre les balises "^" Chaque donnée commence par une lettre D, C, M, T, N, P ou L. Mais certaines données peuvent ne pas exister (comme sur le premier bloc ou M n'est pas connu)

Sur l'onglet "Data classées", j'ai un tableau avec les lettres D, C, M, T, N, P et L.

Je veux que chaque blocs de données en colonne de la feuille "Data brutes" viennent se mettre sur la première ligne vide de la feuille "Data classées" en respectant les lettre et si une données n'existe pas, on passe à la lettre suivante donc le tableau final aura des cellules vides comme ceci et ainsi de suite pour les blocs suivants...

Merci

bonsoir

pour amorcer ,un essai par formule

cordialement

Bonjour à tous,

le meme avec filtre()

Bonsoir à tous !

Une approche via Power Query (nativement intégré dans Excel 2021) ?

Un tableau structuré (tSource) a été inséré dans la feuille "Data brutes".

Si cette source évolue, une simple actualisation (via le ruban par exemple : menu "Données") mettra à jour le tableau retraité par Power Query.

Remarque : La source externe des données peut, avec une légère modification du code, être directement intégrée.

Bonsoir à tous,

Une solution en VBA :

Option Explicit
Sub test()
    Dim a, b, i As Long, ii As Long, n As Long
    Dim flag As Boolean, pos, EnTete, correspondance As String
    With Sheets("Data brutes")
        a = .Range("a1", .Range("a" & Rows.Count).End(xlUp)).Value
    End With
    EnTete = [{"N° de bloc","D","C","M","T","N","P","L"}]
    ReDim b(1 To 100, 1 To 8)
    For i = 1 To UBound(a, 1)
        ii = 0: flag = False
        Do While a(i + ii, 1) <> "^"
            correspondance = Left(a(i + ii, 1), 1)
            pos = Application.Match(correspondance, EnTete, 0)
            If Not IsError(pos) Then
                b(n + 1, pos) = a(i + ii, 1)
                flag = True
            End If
            ii = ii + 1
            ' Sort de la boucle si fin de colonne
            If i + ii > UBound(a, 1) Then Exit Do
        Loop
        If flag Then
            n = n + 1: b(n, 1) = n
        End If
        If ii > 0 Then
            i = i + ii - 1
        End If
    Next
    ' Restitution
    Application.ScreenUpdating = False
    If Not Evaluate("isref('Resultat'!a1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Resultat"
    With Sheets("Resultat")
        With .Cells(1)
            .CurrentRegion.Clear
            If n > 0 Then
                .Resize(, 8).Value = EnTete
                .Offset(1).Resize(n, 8).Value = b
                With .CurrentRegion
                    .Font.Name = "calibri"
                    .Font.Size = 10
                    .VerticalAlignment = xlCenter
                    .Borders(xlInsideVertical).Weight = xlThin
                    .BorderAround Weight:=xlThin
                    With .Rows(1)
                        .HorizontalAlignment = xlCenter
                        .Font.Size = 11
                        .BorderAround Weight:=xlThin
                        .Interior.ColorIndex = 43
                    End With
                    .Columns.AutoFit
                End With
            End If
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonsoir à tous !

Peut-on espérer un retour ?