Macro pour répartir des valeurs en ligne en colonne

Bonjour , j'ai besoin de votre aide pour faire une macro pour répartir des valeurs en ligne en colonne.

Ci joint un exemple de fichier

Merci par avance pour vos solutions

Bonjour,

une proposition de macro, à tester

Sub transfert()
i = 6
While Cells(i, 1) <> ""
 If Cells(i, 4) = "" Then
  Cells(i, 4) = Cells(i, 8)
  Cells(i, 8) = ""
 ElseIf Cells(i, 5) <> "" Then
  Rows(i + 1).Insert shift:=xlDown
  Cells(i + 1, 1) = Cells(i, 1)
  Cells(i + 1, 2) = Cells(i, 2)
  Cells(i + 1, 3) = Cells(i, 5)
  Cells(i, 5) = ""
  If Cells(i, 6) = "" Then
   Cells(i + 1, 4) = Cells(i, 8)
   Cells(i, 8) = ""
   i = i + 1
  Else
   Cells(i + 1, 4) = Cells(i, 6)
   Cells(i, 6) = ""
   Rows(i + 2).Insert shift:=xlDown
   Cells(i + 2, 1) = Cells(i, 1)
   Cells(i + 2, 2) = Cells(i, 2)
   Cells(i + 2, 3) = Cells(i, 7)
   Cells(i, 7) = ""
   Cells(i + 2, 4) = Cells(i, 8)
   Cells(i, 8) = ""
   i = i + 2
  End If
 ElseIf Cells(i, 7) <> "" Then
   Rows(i + 1).Insert shift:=xlDown
   Cells(i + 1, 1) = Cells(i, 1)
   Cells(i + 1, 2) = Cells(i, 2)
   Cells(i + 1, 3) = Cells(i, 7)
   Cells(i, 7) = ""
   Cells(i + 1, 4) = Cells(i, 8)
   Cells(i, 8) = ""
   i = i + 1
 End If
 i = i + 1
Wend
End Sub[code]

[/code]

Bonjour,

Un code similaire :

Sub Test()

    Dim I As Integer
    Dim Adr As String

    With Worksheets("Test")

        For I = .Cells(.Rows.Count, 1).End(xlUp).Row To 6 Step -1

            On Error Resume Next
            Adr = Range("E" & I & ":H" & I).Cells.SpecialCells(xlCellTypeBlanks).Address

            'une erreur est générée si la plage ne comporte aucune cellule vide donc, 2 plages horaires
            If Adr = "" Then

                'insère les deux lignes
                Range("A" & I + 1).EntireRow.Insert
                Range("A" & I + 1).EntireRow.Insert

                'copie les cellules en colonne A et B sur les nouvelles lignes
                Range("A" & I).AutoFill Range("A" & I & ":A" & I + 2), 1
                Range("B" & I).AutoFill Range("B" & I & ":B" & I + 2), 1

                'reporte les heures de début
                Range("C" & I + 1) = Range("E" & I)
                Range("C" & I + 2) = Range("G" & I)

                'reporte les heures de fin
                Range("D" & I + 1) = Range("F" & I)
                Range("D" & I + 2) = Range("H" & I)

            'si il y a des cellules vides donc, 1 plage horaire
            Else

                'insère une ligne
                Range("A" & I + 1).EntireRow.Insert

                'copie les cellules en colonne A et B sur la nouvelle ligne
                Range("A" & I).AutoFill Range("A" & I & ":A" & I + 1), 1
                Range("B" & I).AutoFill Range("B" & I & ":B" & I + 1), 1

                'reporte la plage horaire
                Range("C" & I + 1) = IIf(Range("E" & I) = "", Range("G" & I), Range("E" & I))
                Range("D" & I + 1) = IIf(Range("F" & I) = "", Range("H" & I), Range("F" & I))

            End If

            Adr = ""

        Next I

    End With

End Sub

Hervé.

Merci , j'ai choisi la solution de h2so4.

Cela me fait gagner beaucoup de temps.