Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .CountLarge > 1 Then Exit Sub
Dim lg1&: lg1 = .Row: If lg1 < 4 Then Exit Sub
Dim lg2&, k1&, k2 As Byte, col%: Application.ScreenUpdating = 0
k1 = lg1 - 4: k2 = k1 Mod 3: lg2 = (k1 \ 3) + 4: col = .Column
If col < 3 Or col > 4 Then Exit Sub
If IsEmpty(.Value) Then
Cells(lg1, 5) = Empty: Cells(lg2, 7 + k2) = Empty: Exit Sub
End If
End With
If col = 3 And IsEmpty(Cells(lg1, 4)) Then Exit Sub
Dim moy%
moy = WorksheetFunction.RoundUp((Cells(lg1, 3) + Cells(lg1, 4)) / 2, 0)
Cells(lg1, 5) = moy: Cells(lg2, 7 + k2) = moy
If col = 3 Or k2 > 0 Then Exit Sub
With Cells(lg1, 1)
Cells(lg2, 6) = .Offset(1).Value
Cells(lg2, 10) = .Value
Cells(lg2, 11) = .Offset(2)
End With
End Sub