Sub FaireleTruc()
Dim plg As Range
Dim lig As Long
With ThisWorkbook.Sheets("Feuil1").Range("A4").CurrentRegion
' copier coller la ligne d'entête
.Rows(1).Copy .Offset(, .Columns.Count + 1)
' travailler sur les lignes et colonnes de données, sans les entêtes
With .Offset(1).Resize(.Rows.Count - 1, 5)
' Copier coller l'ensemble
.Copy .Offset(, .Columns.Count + 1)
' Copier La colonne REF et les colonnes 4,5 pour les coller en bas du tableau
Union(.Columns(1), .Columns(4), .Columns(5)).Copy .Offset(.Rows.Count, .Columns.Count + 1)
' Nettoyer les données des deux dernières colonnes du nouveau tableaux
.Offset(, .Columns.Count + 4).Resize(, 2).ClearContents
End With
Set plg = .Offset(, .Columns.Count + 1).Resize(, .Columns.Count).CurrentRegion
End With
'
' Travailler sur le nouveau tableau
With plg
' Tri sur tarif 1 pour avoir les valeurs 0 en bas
.Sort key1:=.Cells(1, 3), order1:=xlAscending, Header:=xlYes
For lig = .Rows.Count To 2 Step -1
' Si Tarif 1 n'est pas vide alors sortir de la boucle
If Not IsEmpty(.Cells(lig, 3)) Then Exit For
.Rows(lig).Delete xlShiftUp
Next lig
' Tri sur REF
.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
End With
End Sub