Macro avec alignement de données

Bonjour à tous

J'essaye de développer une macro qui me permettrait d'automatiser la récolte de données depuis 2 autres tableaux excel et la mise en forme de celles-ci.

Je n'ai que des bases scolaires en programmation, j'ai donc utilisé ChatGPT pour écrire cette macro. La récolte de données fonctionne, par contre, après plusieurs heures de recherche, je n'arrive pas à aligner correctement ces données importées pour la mise en forme.

La macro importe les données de cette manière :

Je souhaite obtenir cet alignement :

Ci-joint le fichier excel en question avec le premier onglet montrant le résultat obtenu, et le deuxième le résultat souhaité.

J'ai déjà vu d'anciens postes avec le même problème d'alignement, mais les solutions étaient apportées sous forme de fonction, pas de macros.

Merci

Bonjour

sur base de votre fichier, essayez avec ce code

Sub test()
Dim cel As Range
Dim dlg As Byte

For Each cel In Range("B5:B" & Range("B" & Rows.Count).End(xlUp).Row)
    If cel.Value <> Range("O" & cel.Row) Then Range("O" & cel.Row).Insert
Next cel
End Sub

Si il est possible que vous ayez des inversions en colonne O dans la progression des données, le code ne sera pas exact évidemment

Cordialement

ça fonctionne !

de ce que je comprends, votre code détecte les différences pour chaque lignes entre les colonnes B et O, puis insert une cellule dans la colonne O lorsqu'il repère une différence.

If cel.Value <> Range("O" & cel.Row) Then Range("O" & cel.Row).Insert

> comment pourrait on faire en sorte que l'insert se fasse aussi sur les colonnes P, Q et R ?

J'ai essayé : Then Range("O, P, Q, R" & cel.Row).Insert
si jamais ça peut vous aider à comprendre

de ce que je comprends, votre code détecte les différences pour chaque lignes entre les colonnes B et O, puis insert une cellule dans la colonne O lorsqu'il repère une différence.

Exact oui.

comment pourrait on faire en sorte que l'insert se fasse aussi sur les colonnes P, Q et R ?

Vous remplacez cette ligne

If cel.Value <> Range("O" & cel.Row) Then Range("O" & cel.Row).Insert

Par ceci

If cel.Value <> Range("O" & cel.Row) Then Range("O" & cel.Row & ":R" & cel.Row).Insert

Rem :
- lorsque vous postez un code pensez à utiliser les balises de code en cliquant sur l'icone </> dans la barre de menu

ça fonctionne parfaitement,

merci Dan

Ok.
Attention que cela veut dire que la progression des infos en colonne B est identique à la colonne O

Si vous aviez par exemple en O6 "Local VDI" à la place de "Salle de réunion", le code ne va pas vous donner les résultats attendus. Dans ce cas, il faut modifier le code que je vous ai proposé

Rem: pensez à modifier votre version excel dans votre profil de compte. 2410 n'est pas une version mais plutôt un indice.
Pour la trouver : ---> menu Fichier > Compte (en bas) + Clic sur le point d'interrogation puis sur la page suivante au-dessus vous trouvez

Cordialement

Bonjour à tous ,

Une macro indifférente à l'ordre des pièces dans le tableau source. Cliquez sur le bouton "Aligner".

Le code (un peu commenté) est dans module1. La macro s'appelle Alignement.

Sub Alignement()
Dim t, i&, n&, j&, aux
   With Sheets("TABLEAU PUISSANCES")
      t = .Cells(1, 15).Resize(.Cells(Rows.Count, 2).End(xlUp).Row, 4).Value  ' le tableau colonne 15 à 18
      ReDim v(1 To UBound(t), 1 To UBound(t, 2))                        ' le tableau résultat r
      For i = 1 To 4: For j = 1 To 4:: v(i, j) = t(i, j): Next j, i     ' titre dans r (lignes 1 à 5)
      For i = 5 To UBound(t)                                            ' à partir de la ligne 5
         ' n -> ligne de la pièce en colonne 15 au sein de la colonne 2 (retourne 0 si pas dans colonne 2)
         n = Application.IfError(Application.Match(t(i, 1), .Columns(2), 0), 0)
         If n > 0 Then For j = 1 To 4: v(n, j) = t(i, j): Next    ' recopie dans r à la position n
      Next i
      .Cells(1, 15).Resize(UBound(v), UBound(v, 2)) = v           ' transfert de r sur la feuille
   End With
End Sub