Sub Importer()
Dim chemin$, fichier, F As Worksheet, a, b, n%, dest As Range, i&, j&, h%
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Apports.xlsx"
If Dir(chemin & fichier) = "" Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: Exit Sub
Set F = ActiveSheet
a = Array("DECHET", "ENTIER")
b = Array("DECHET Total", "ENTIER Total")
Application.ScreenUpdating = False
F.[C42:C51,D42:F52,L42:L51,M42:O52].ClearContents 'RAZ
On Error Resume Next 'si le fichier n'est pas ouvert
Workbooks(fichier).Close False 'si le fichier est ouvert on le ferme
On Error GoTo 0
With Workbooks.Open(chemin & fichier).Sheets(1) 'ouverture du fichier source
For n = 0 To UBound(a)
Set dest = IIf(n, F.[C42], F.[L42]) '1ère cellule de destination
i = Application.Match(a(n), .Columns(3), 0)
j = Application.Match(b(n), .Columns(3), 0)
If j > i + 1 Then
With .Rows(i & ":" & j - 1)
.UnMerge 'défusionne les cellules pour permettre le tri
.Sort .Columns(6), xlDescending, Header:=xlNo 'tri décroissant sur la colonne F
h = IIf(.Rows.Count > 10, 10, .Rows.Count)
dest.Resize(h) = .Columns(4).Resize(h).Value 'D
dest(1, 2).Resize(h) = .Columns(6).Resize(h).Value 'F
dest(1, 3).Resize(h) = .Columns(10).Resize(h).Value 'J
dest(1, 4).Resize(h) = .Columns(16).Resize(h).Value 'P
If .Rows.Count > 10 Then
.Resize(10).ClearContents 'pour ne pas tenir compte des valeurs
dest(11, 2) = Application.Sum(.Columns(6)) 'somme sur F
dest(11, 3) = Application.Average(.Columns(10)) 'moyenne sur J
dest(11, 4) = Application.Average(.Columns(16)) 'moyenne sur P
End If
End With
End If
Next
.Parent.Close False 'fermeture du fichier source
End With
End Sub