Option Compare Text 'la casse est ignorée
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Devis*" Then Exit Sub
Dim i&
Application.ScreenUpdating = False
With Sh
.[B:B].Copy .[I1]
.[E:E].Copy .[J1]
.[C:D].Copy .[K1]
.Range("M2:N" & .Rows.Count).Delete xlUp 'RAZ
With [I1].CurrentRegion
If .Rows.Count = 1 Then Exit Sub
.Sort .Cells(1), xlAscending, Header:=xlYes
For i = .Rows.Count To 2 Step -1
If .Cells(i, 1) = .Cells(i - 1, 1) Then _
.Cells(i - 1, 2) = .Cells(i - 1, 2) + .Cells(i, 2): .Rows(i).Delete xlUp 'élimine les doublons
Next
With .Cells(2, 5).Resize(.Rows.Count - 1, 2) 'colonnes M:N
.Columns(1) = "=VLOOKUP(RC[-4],BDD_Technique!C1:C6,6,0)" 'RECHERCHEV
.Columns(2) = "=RC[-4]*RC[-1]" 'Quantité x Prix U.H.T
.Value = .Value 'supprime les formules
.Borders.Weight = xlThin 'complète les bordures
End With
End With
End With
End Sub