Eclater une ligne en plusieurs ligne

Bonjour,

Je débute en VBA, j'ai besoin de votre aide.

J'ai un tableau sur la "Feuil1", je souhaiterai que ce tableau soit copié sur une "Feuil2" et que chaque ligne soit éclatée en plusieurs lignes

La colonne A ne doit pas être reprise dans la "Feuil2"

Feuil1 de départ

Résultat attendu en "Feuil2"

Merci beaucoup d'avance

Bonjour LelockJohn et

Voici ton fichier avec le code qui semble bien fonctionner

Je te laisse mettre les couleurs

@+

Parfait !

Merci bcp

Si j'avais su que c'était si facile j'aurais fait une demande plus complexe :)

Pour les couleurs mon code fonctionne mais il change la couleur de toute la ligne, je voudrais qu'il se limite au 8 colonnes.
Est ce possible svp ?

_____________________________________________________________________

Sub Couleurs()

Dim ShtS As Worksheet, ShtD As Worksheet
Dim dLigS As Long, LigS As Long, nLigD As Long
Dim MemNiv(3) As Variant
Dim ligne As Integer: Dim colonne As Integer
Dim der_colonne As Integer

' Dernière ligne de la feuille
dLigS = ShtS.Range("H" & Rows.Count).End(xlUp).Row
' Dernière colonne de la feuille
der_colonne = Cells.SpecialCells(xlCellTypeLastCell).Column

For ligne = 2 To dLigS

For colonne = 1 To der_colonne

If Worksheets("Result").Cells(ligne, 1) <> "" Then Worksheets("Result").Rows(ligne).Interior.Color = RGB(226, 239, 218)
If Worksheets("Result").Cells(ligne, 2) <> "" Then Worksheets("Result").Rows(ligne).Interior.Color = RGB(226, 239, 218)
If Worksheets("Result").Cells(ligne, 3) <> "" Then Worksheets("Result").Rows(ligne).Interior.Color = RGB(217, 245, 242)
If Worksheets("Result").Cells(ligne, 4) <> "" Then Worksheets("Result").Rows(ligne).Interior.Color = RGB(217, 245, 242)
If Worksheets("Result").Cells(ligne, 5) <> "" Then Worksheets("Result").Rows(ligne).Interior.Color = RGB(255, 242, 204)
If Worksheets("Result").Cells(ligne, 6) <> "" Then Worksheets("Result").Rows(ligne).Interior.Color = RGB(255, 242, 204)

Next colonne
Next ligne

End Sub

___________________________________

Bonjour lelockjohn, BrunoM45, le forum,

il change la couleur de toute la ligne, je voudrais qu'il se limite au 8 colonnes

Un essai....à partir de ta macro...

Sub Couleurs()

Dim ShtS As Worksheet
Dim dLigS As Long
Dim ligne As Integer, colonne As Integer, der_colonne As Integer

Application.ScreenUpdating = False

   'feuille sur laquelle on applique les couleurs
Set ShtS = Sheets("Result")

With ShtS
   ' Dernière ligne de la feuille
  dLigS = .Range("H" & Rows.Count).End(xlUp).Row
   ' Dernière colonne de la feuille
  der_colonne = .Cells.SpecialCells(xlCellTypeLastCell).Column

 For ligne = 2 To dLigS
  For colonne = 1 To der_colonne
   .Columns.AutoFit                      'adapte la largeur des colonnes au contenu
   If .Cells(ligne, 1) <> "" Then .Cells(ligne, colonne).Interior.Color = RGB(226, 239, 218)
   If .Cells(ligne, 2) <> "" Then .Cells(ligne, colonne).Interior.Color = RGB(226, 239, 218)
   If .Cells(ligne, 3) <> "" Then .Cells(ligne, colonne).Interior.Color = RGB(217, 245, 242)
   If .Cells(ligne, 4) <> "" Then .Cells(ligne, colonne).Interior.Color = RGB(217, 245, 242)
   If .Cells(ligne, 5) <> "" Then .Cells(ligne, colonne).Interior.Color = RGB(255, 242, 204)
   If .Cells(ligne, 6) <> "" Then .Cells(ligne, colonne).Interior.Color = RGB(255, 242, 204)
  Next colonne
 Next ligne
End With

Application.ScreenUpdating = True

End Sub

Cordialement,

parfait merci !