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

oguruma

XLDnaute Occasionnel
Suite de ce post

Comment y parvenir via une macro en VBA ?

VB:
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
 

Pièces jointes

  • Transpose_Blocs_Lignes_Colonnes_V3.xlsm
    50.4 KB · Affichages: 10

Discussions similaires

Statistiques des forums

Discussions
312 866
Messages
2 093 029
Membres
105 612
dernier inscrit
douboumin