Private Sub CommandButton1_Click() 'Bouton Récup
Dim cel As Range 'déclaration de la variable cel
Dim dest As Range 'déclaration de la variable dest
Dim dest2 As Range
Dim x As Byte 'déclaration la variable x
Dim y As Byte
Worksheets("Suivi des actions 2010").Range("A32:B6000").Clear 'Efface les anciennes données
ActiveSheet.Outline.ShowLevels RowLevels:=2 'Degrouper les lignes
Columns("B:B").Select 'Estétique
With Selection
.HorizontalAlignment = xlCenter
End With
Range("B28").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With 'Fin estétique
ActiveCell.Select 'Enleve Focus du bouton
For Each cel In Sheets("Liste 2010").Range("W397:W" & Sheets("Liste 2010").Range("U65536").Row) 'Selectionne l'ensemble des cellules Collone W à partir de W397
If cel.Value > 0 Then 'Test chaque cellule si la valeur >0
For x = 1 To cel.Value + 1 'Boucle de 1 à Valeur Colonne W+1
Set dest = Sheets("Suivi des actions 2010").Range("A65536").End(xlUp).Offset(1, 0) 'Set de la destination
dest.Value = cel.Offset(0, -22)
dest.Offset(0, 1).Value = cel.Offset(0, -19).Value
'
If x = 1 Then 'Estétique Cellule
With dest.Interior '|
.ColorIndex = 15 '|
End With '|
With dest.Offset(0, 1).Interior '|
.ColorIndex = 15 '|
End With '|
With dest.Offset(0, 2).Interior '|
.ColorIndex = 15 '|
End With '|
With dest.Offset(0, 3).Interior '|
.ColorIndex = 15 '|
End With '|
With dest.Offset(0, 4).Interior '|
.ColorIndex = 15 '|
End With
End If 'Fin estétique
Next x
Set dest1 = Sheets("Suivi des actions 2010").Range("A65536").End(xlUp).Offset(1, 0)
End If ' Fin de boucle
Next cel 'Fin de boucle
Range("A32:F770").Select 'Estétique Cellule
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
ActiveSheet.Outline.ShowLevels RowLevels:=1 ' Regroupe les lignes
End Sub