Sub Transfert2()
Application.ScreenUpdating = False
Set Ref = Sheets("Ref")
Set Qte = Sheets("Qte")
With Ref
n = .Cells(65536, 15).End(xlUp).Row 'dernière ligne non vide en colonne R
.Range("R6:R" & n).ClearContents 'effacer contenu colonne R
.Range("O6:O" & n).ClearContents 'effacer contenu colonne O
If n > 6 Then .Range("A7:R" & n).Clear 'vider plage A7 à Rn
End With
n = 6
With Qte
For i = 12 To .Cells(65536, 17).End(xlUp).Row
If .Cells(i, 17).Value <> "" And .Cells(i, 17).Value > 0 And .Cells(i, 17).Interior.ColorIndex = 35 Then '<> 6 Then '6=jaune; 35=vert
Ref.Cells(n, 15).Value = .Cells(i, 17).Value
Ref.Cells(n, 18).Value = .Cells(i, 2).Value
Ref.Cells(n, 12).Value = .Cells(i, 1).Value
n = n + 1
End If
Next i
End With
With Ref
n = .Range("R" & Rows.Count).End(xlUp).Row
.Rows("6:6").Copy
For i = 7 To n
.Rows(i).PasteSpecial Paste:=xlPasteFormats
.Range("A" & i) = .Range("A" & i - 1) + 10
.Range("D" & i) = .Range("D" & i - 1)
.Range("G" & i) = .Range("G" & i - 1)
.Range("I" & i) = .Range("I" & i - 1)
.Range("P" & i) = .Range("P" & i - 1)
Next i
'formule
n = .Range("R" & Rows.Count).End(xlUp).Row
.Range("O" & n + 3).FormulaLocal = "=Somme(O6:O" & n & ")"
.Range("O" & n + 4).Value = .Range("O" & n + 3)
.Range("H" & n + 3).FormulaLocal = "=Somme(H6:H" & n & ")"
.Range("H" & n + 4) = 989789
.Range("L" & n + 4).Formula = "=H" & n + 4 & "/O" & n + 4
'mef
.Range("H" & n + 3, "O" & n + 4).Font.Bold = True
.Range("H" & n + 3, "O" & n + 4).Font.Name = "Arial"
.Range("H" & n + 3, "O" & n + 4).Font.Color = -16776961
For j = 6 To n
.Cells(j, 8) = .Cells(n + 4, 12).Value * .Cells(j, 15).Value
Next j
End With
Application.CutCopyMode = False
End Sub