Sub donnees2()
Application.ScreenUpdating = False
Dim pl As Range
'On Error Resume Next
With Sheets("RECAP RES")
derlig = .Cells(799, 2).End(xlUp).Row
Set pl = .Range(.Cells(1, 2), .Cells(derlig, 8))
pl.Name = "base"
.Range("B1:B" & [COLOR="Red"]derlig[/COLOR]).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("travail").Range("A1"), Unique:=True
.Range("C1:C" & [COLOR="Red"]derlig[/COLOR]).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("travail").Range("B1"), Unique:=True
.Range("D1[COLOR="Red"]:D[/COLOR]" & [COLOR="Red"]derlig[/COLOR]).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("travail").Range("C1"), Unique:=True
End With
For i = 1 To 3
With Sheets("travail")
derlig = .Cells(799, i).End(xlUp).Row
Set pl = .Range(.Cells(2, i), .Cells(derlig, i))
pl.Name = "base" & i
.Range("base" & i).Sort Key1:=.Cells(2, i), Order1:=xlAscending
End With
With Sheets("EtqDESS")
.Cells(2, i).Validation.Delete
.Cells(2, i).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=base" & i
.[IV2].FormulaR1C1 = _
"=AND(EtqDESS!R2C1='RECAP RES'!RC[-254],EtqDESS!R2C2='RECAP RES'!RC[-253],EtqDESS!R2C3='RECAP RES'!RC[-252])"
.[H2] = Sheets("RECAP RES").[H1]
Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"IV1:IV2"), CopyToRange:=.Range("H2"), Unique:=True
.Range(Cells([COLOR="Red"]2[/COLOR], 8), Cells(799, 8)).Sort Key1:=[COLOR="Red"].[/COLOR]Range("H3"), Order1:=xlAscending
.[H2].ClearContents
End With
Next i
.[H1].Select
End Sub