Transposer en colonnes des blocs de données en lignes - via Macro

[oguruma]

Suite de ce post

Transposer en colonnes des blocs de données en lignes - via formules - LET & LAMBDA

Suite du sujet comme annoncé dans le post initial ici https://excel-downloads.com/threads/transposer-en-colonnes-des-blocs-de-donnees-en-lignes-via-formules.20080376/ transformation de la formule DECALER avec tous ses composants en une fonction LAMBDA en passant par LET. L'exemple retenu simule...

excel-downloads.com

Comment y parvenir via une macro en VBA ?

Option Explicit


Sub DEGROUPER_LIGNES_COLONNES()
    
    Dim DataSource As Range
    Dim lngIndexRow As Long
    Dim lngIndexColumn As Long
    Dim LngIndexStartRow As Long
    Dim LngIndexStartColumn As Long
    Dim lngParse As Long
    Dim lngMaxLoopRow As Long
    Dim lngMaxLoopCol As Long
    Dim iNbItem As Integer
    Dim WkCible As Worksheet
    
    ' Source des données à dégrouper
    Set DataSource = Range("COL_RUBRIQUES")
    
    ' Nombre d'item par bloc
    iNbItem = Range("NB_RUBRIQUES_GROUPE")
    
    ' Index de départ ligne et colonne
    LngIndexStartRow = Range("LIGNE_DEBUT_DONNEES").Value
    LngIndexStartColumn = Range("COLONNE_DEBUT_DONNEES").Value
    lngIndexRow = LngIndexStartRow
    lngIndexColumn = LngIndexStartColumn
  
    ' On se positionne sur l'onglet cible
    Set WkCible = Worksheets(Range("ONGLET_CIBLE").Value)
    WkCible.Activate
    
    ' Réinitialise la feuille
    Cells.ClearContents
    
    ' On positionne les titres des colonnes par formule - bcp plus simple
    Cells(LngIndexStartRow - 1, LngIndexStartColumn).Formula2R1C1 = _
     "=TRANSPOSE(INDIRECT(ADRESSE_RUBRIQUE & "":"" & ADRESSE_RUBRIQUE_FIN))"
    
    ' Init du parsing des données
    lngParse = 0
    lngMaxLoopRow = (LngIndexStartRow + (DataSource.Rows.Count / iNbItem))
    
    ' Parsing des données ligne/colonne
    For lngIndexRow = LngIndexStartRow To lngMaxLoopRow
        ' On détermine les limites du parsing
        lngMaxLoopCol = LngIndexStartColumn + iNbItem - 1
        ' dispatching en colonne
        For lngIndexColumn = LngIndexStartColumn To lngMaxLoopCol
            ' on se déplace dans le tableau
            lngParse = lngParse + 1
            ' On va se décaler d'une cellule pour récupérer la valeur de l'item et affectation
            WkCible.Cells(lngIndexRow, lngIndexColumn).Value = DataSource.Cells(lngParse, 1).Offset(0, 1)
        Next lngIndexColumn
        ' et traitement du bloc suivant
    Next lngIndexRow
    
    MsgBox "Dégroupage des données effectué"
    
End Sub

voir le fichier joint