Présentation de colonnes en liste de données

[Amilo]

Bonsoir le forum,

Je bloque sur un problème complexe à mon niveau mais certainement réalisable par VBA,
Je vous joins un fichier avec je l'espère toutes les explications nécessaires à la compréhension.

Est-il possible de résoudre tel problème ?
J'ai tenté à coup de formules mais en vain...

Merci d'avance pour votre aide

Cordialement

 

[PMO2]

Re : Présentation de colonnes en liste de données

Bonjour,

Je me suis basé entièrement sur votre pièce jointe.
Si dans la réalité la structure de la feuille source est différente, cela ne va pas fonctionner.

La difficulté rédhibitoire est la différence du nombre d'éléments dans chaque groupe de la colonne B.
Il n'y a rien pour distinguer des familles; les données sont reproduites comme elles se présentent et ne sont, par conséquent, pas alignées.

1) Copiez le code suivant dans un module Standard

Sub aa()
Dim S As Worksheet
Dim R As Range
Dim var
Dim i&
Dim cpt&    'compteur
Dim Lig&
Dim Col&
Dim T()
'--- La feuille source ---
Set R = ActiveSheet.UsedRange
Set R = R.Resize(R.Rows.Count + 1, R.Columns.Count)
var = R
'--- Une nouvelle feuille pour afficher les résultats ---
Sheets.Add
Set S = ActiveSheet

'--- La colonne B ---
Lig& = 0
Col& = 1
For i& = 1 To UBound(var, 1)
  cpt& = cpt& + 1
  If var(i&, 1) <> "" Then
    ReDim Preserve T(1 To 1, 1 To cpt&)
    T(1, cpt&) = var(i&, 1)
  Else
    cpt& = 0
    Lig& = Lig& + 1
    Set R = S.Range(S.Cells(Lig&, Col&), S.Cells(Lig&, UBound(T, 2) + Col& - 1))
    R = T
    Erase T
  End If
Next i&
'--- La colonne C ---
Lig& = 0
Col& = S.UsedRange.Columns.Count + 1
For i& = 1 To UBound(var, 1)
  If var(i&, 1) <> "" Then
    If var(i&, 2) <> "" Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 1, 1 To cpt&)
      T(1, cpt&) = var(i&, 2)
    End If
  Else
    Lig& = Lig& + 1
    If cpt& > 0 Then
      Set R = S.Range(S.Cells(Lig&, Col&), S.Cells(Lig&, UBound(T, 2) + Col& - 1))
      R = T
    End If
    cpt& = 0
    Erase T
  End If
Next i&
'--- La colonne J ---
Lig& = 0
Col& = S.UsedRange.Columns.Count + 1
For i& = 1 To UBound(var, 1)
  If var(i&, 1) <> "" Then
    If var(i&, 9) <> "" Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 1, 1 To cpt&)
      T(1, cpt&) = var(i&, 9)
    End If
  Else
    Lig& = Lig& + 1
    If cpt& > 0 Then
      Set R = S.Range(S.Cells(Lig&, Col&), S.Cells(Lig&, UBound(T, 2) + Col& - 1))
      R = T
    End If
    cpt& = 0
    Erase T
  End If
Next i&
'--- La colonne L ---
Lig& = 0
Col& = S.UsedRange.Columns.Count + 1
For i& = 1 To UBound(var, 1)
  If var(i&, 1) <> "" Then
    If var(i&, 11) <> "" Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 1, 1 To cpt&)
      T(1, cpt&) = var(i&, 11)
    End If
  Else
    Lig& = Lig& + 1
    If cpt& > 0 Then
      Set R = S.Range(S.Cells(Lig&, Col&), S.Cells(Lig&, UBound(T, 2) + Col& - 1))
      R = T
    End If
    cpt& = 0
    Erase T
  End If
Next i&
End Sub

2) Sélectionnez la feuille source et lancez la macro "aa" (que vous pouvez renommer à votre guise).

 

[Amilo]

Re : Présentation de colonnes en liste de données

Bonsoir PM02,

Mille mercis pour votre code que je viens de tester sur mon fichier perso,
Je suis agréablement surpris du résultat et c'est presque parfait,
Sur l'ensemble des 2500 lignes, seules 120 sont décalées par rapport aux titres,
Par un simple filtre, j'arrive à isoler les 120 lignes qui font défaut et les glisser/déposer à l'emplacement voulu,
Je n'ai que 2 ou 3 manipulations de ce genre et c'est parfait alors que ça m'aurait pris plusieurs heures voire jours sans votre code avec le risque de commettre des erreurs devant un travail fastidieux

Merci encore pour le travail et votre sympathie,

Très bonne soirée à vous