Salut,
Voici un essai :
Option Explicit
Sub xx()
Dim DerLig As Integer, Première_Ligne As Integer, Dernière_Ligne As Integer, i As Integer
Application.ScreenUpdating = False
Range("H:I").ClearContents
DerLig = Range("A" & Rows.Count).End(xlUp).Row
Range("A4:F" & DerLig).Sort Key1:=Range("C4"), Order1:=xlAscending, Header:=xlNo
Range("C4").Activate
Retour:
Première_Ligne = ActiveCell.Row
Do Until ActiveCell.Offset(1, 0) <> ActiveCell
If ActiveCell = "" Then Exit Sub
ActiveCell.Offset(1, 0).Activate
Loop
Dernière_Ligne = ActiveCell.Row
Cells(Dernière_Ligne, 8) = "Moyenne de " & Cells(Dernière_Ligne, 3)
Cells(Dernière_Ligne, 9) = Application.Sum(Range(Cells(Première_Ligne, 6), Cells(Dernière_Ligne, 6))) / (Dernière_Ligne - Première_Ligne + 1)
ActiveCell.Offset(1, 0).Activate
GoTo Retour
End Sub
Cordialement.