Bonsoir Jean Marie et le forum,
merci d'avoir corrigé la macro. je l'ai bien testé et maintenant elle fonctionne.
Il y avait juste un dysfonctionnement lorsque je lancais 2 fois de suite la macro (ca boguait au niveau de la suppression des #), j'ai donc rajouté un code simple pour effacer les #. ca fonctionne impec. (cf plus bas)
ca me donne une macro par très catholique mais au moins ca fonctionne comme je le voulais et c'est l'essentiel.
Encore un grand merci pour ton aide. et surement à très bientot sur le forum.
@ +
emmanuel
Sub trier()
' deprotéger la feuille
ActiveSheet.Unprotect
'effacer le contenu des colonnes G et H
Range("G2:H250").Select
Selection.ClearContents
'trier les lignes
Range("A2:E250").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'effacer les #
Dim Plage As Range
Dim Cell As Range
Set Plage = Range("C2:C" & Range("C65535").End(xlUp).Row)
For Each Cell In Plage
If Cell.Value = "#" Then
Cell.Clear
End If
Next Cell
'ici commence la macro
Dim c As Range
Dim firstAddress As String
Dim ChaineSelection As String
Dim I As Double
Application.ScreenUpdating = False
'efface les lignes
ChaineSelection = ""
With Range("C2", Range("C65536").End(xlUp).Address)
Set c = .Find("#", After:=Range("C2"))
If Not c Is Nothing Then
firstAddress = c.Address
Do
ChaineSelection = ChaineSelection & Range(c.Offset(0, -2), c.Offset(0, 2)).Address & ","
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
ChaineSelection = Mid(ChaineSelection, 1, Len(ChaineSelection) - 1)
Range(ChaineSelection).Delete shift:=xlUp
End If
End With
'insère les lignes
For I = Range("E65536").End(xlUp).Row To 2 Step -1
If Range("E1").Offset(I - 1, 0) > 1 Then
Range(Range("A1").Offset(I, 0), Range("E1").Offset(Range("E1").Offset(I - 1, 0) + I - 2, 0)).Insert shift:=xlDown
Range(Range("C1").Offset(I, 0), Range("C1").Offset(Range("E1").Offset(I - 1, 0) + I - 2, 0)) = "#"
End If
Next
Dim vLigne As Double
vLigne = 1
For I = 1 To Range("J65536").End(xlUp).Row - 1
If Range("k1").Offset(I, 0) > 0 Then
Range(Range("G1").Offset(vLigne, 0), Range("G1").Offset(vLigne + Range("k1").Offset(I, 0) - 1, 0)) = Range("J1").Offset(I, 0)
vLigne = vLigne + Range("k1").Offset(I, 0)
End If
Next
'fin de la macro
' recopier la formule de H2 à H250
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-4]),"""",RC[-4]-(RC[-1]+2))"
Range("H2:H250").Select
Selection.FillDown
'enlever protection cellule
Range("A2:I65536").Select
Selection.Locked = False
'se positionner en B2
Range("B2").Select
'protéger la feuille
ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub