Bjr,
Dans cette version, les observations que tu mettras seront reprises dans l'onglet AFFAIRES
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "LONGUEURS *" Then Exit Sub
Sheets("AFFAIRES").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sh.Range("A1").CurrentRegion, CopyToRange:=Sh.Range("A4").CurrentRegion.Resize(1), Unique:=False
Range("A5:D" & Range("A4").End(xlDown).Row).Interior.Pattern = xlNone
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Name Like "LONGUEURS *" Then Exit Sub
If Intersect(Target, Sh.Columns("D:D")) Is Nothing Then Exit Sub
With Sheets("AFFAIRES")
For Each cel In Intersect(Target, Sh.Columns("D:D"))
If cel.Row > 4 Then
.Range("P" & ici(.Columns("D"), Range("A" & cel.Row), Mid(Range("A2"), 2, Len(Range("A2")) - 2), 6).Row) = cel.Value
End If
Next
End With
End Sub
Function ici(plage As Range, valeur1 As Variant, valeur2 As Variant, decalage As Integer) As Range
With plage
ok = False
Set ici = .Find(valeur1, LookIn:=xlValues)
If Not ici Is Nothing Then
prem = ici.Address
Do
If ici.Offset(0, decalage) = valeur2 Then ok = True
If Not ok Then Set ici = .FindNext(ici)
Loop While Not ici Is Nothing And ici.Address <> prem And Not ok
End If
End With
End Function