Groupage

[XciD69]

Bonjour,

J'ai un petit soucis, j'ai une macro avec une boucle et j'aimerais que avant la fin de cette boucle elle sélectionne automatiquement les x (variable) dernières lignes pour les groupés.

je sais comment on groupe une selection:


cellule.Select
Selection.Rows.Group

c'est dans la définition de cellule que je bug, j'arrive pas à le définir en fonction des x dernières lignes qu'il vient d'écrire

 

[Paritec]

Re : Groupage

Bonsoir XciD69,
un petit fichier nous permettrait de t'aider
a+
papou

 

[XciD69]

Re : Groupage

Bon mon fichier est trop lourd :

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