Option Explicit
Sub Copie()
't = Données TABLE 0
't1 = Données TABLE I
't2 = Données TABLE II
Dim f1 As Worksheet, f2 As Worksheet, t, t1, t2, a()
Dim i As Integer, n As Integer, moyenne As Long, moyenne2 As Long, moyenne3 As Long
Set f1 = Sheets("Source")
Set f2 = Sheets("Resultat")
f1.Range("D6" & ":E" & f1.Range("D" & Rows.Count).End(xlUp).Row).Copy Destination:=f2.Range("A17")
'Tri des données TABLE 0 Ordre décroissant
f2.Sort.SortFields.Clear
f2.Sort.SortFields.Add Key:=Range("B17:B" & Range("A" & Rows.Count).End(xlUp).Row) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With f2.Sort
.SetRange f2.Range("A17" & ":B" & f2.Range("A" & Rows.Count).End(xlUp).Row)
.Apply
End With
'Copier la borne supérieure des données TABLE 0 vers la TABLE I
t = f2.Range("A17" & ":B" & f2.Range("A" & Rows.Count).End(xlUp).Row)
ReDim a(1 To UBound(t), 1 To UBound(t))
moyenne = [B5].Value
For i = 1 To UBound(t)
If t(i, 2) >= moyenne Then
n = n + 1
a(n, 1) = t(i, 1)
a(n, 2) = t(i, 2)
End If
Next i
f2.Range("D17").Resize(UBound(a), 2) = a
'Copier la borne inférieure des données TABLE 0 vers la TABLE II
ReDim a(1 To UBound(t), 1 To UBound(t))
n = 0
For i = 1 To UBound(t)
If t(i, 2) < moyenne Then
n = n + 1
a(n, 1) = t(i, 1)
a(n, 2) = t(i, 2)
End If
Next i
f2.Range("G17").Resize(UBound(a), 2) = a
'Copier la borne supérieure des données TABLE I vers la STRATE TABLE I (K17)
moyenne2 = [E5].Value
t1 = f2.Range("D17" & ":E" & f2.Range("A" & Rows.Count).End(xlUp).Row)
ReDim a(1 To UBound(t1), 1 To UBound(t1))
n = 0
For i = 1 To UBound(t1)
If t1(i, 2) >= moyenne2 Then
n = n + 1
a(n, 1) = t1(i, 1)
a(n, 2) = t1(i, 2)
End If
Next i
f2.Range("K17").Resize(UBound(a), 2) = a
'Copier la borne inférieure des données TABLE I vers la STRATE TABLE I (N17)
ReDim a(1 To UBound(t1), 1 To UBound(t1))
n = 0
For i = 1 To UBound(t1)
If t1(i, 2) < moyenne2 Then
n = n + 1
a(n, 1) = t1(i, 1)
a(n, 2) = t1(i, 2)
End If
Next i
f2.Range("N17").Resize(UBound(a), 2) = a
'Copier la borne supérieure des données TABLE II vers la STRATE TABLE II (Q17)
moyenne3 = [H5].Value
t2 = f2.Range("G17" & ":H" & f2.Range("A" & Rows.Count).End(xlUp).Row)
ReDim a(1 To UBound(t2), 1 To UBound(t2))
n = 0
For i = 1 To UBound(t2)
If t2(i, 2) >= moyenne3 Then
n = n + 1
a(n, 1) = t2(i, 1)
a(n, 2) = t2(i, 2)
End If
Next i
f2.Range("Q17").Resize(UBound(a), 2) = a
'Copier la borne inférieure des données TABLE II vers la STRATE TABLE II (T17)
ReDim a(1 To UBound(t2), 1 To UBound(t2))
n = 0
For i = 1 To UBound(t2)
If t2(i, 2) < moyenne3 Then
n = n + 1
a(n, 1) = t2(i, 1)
a(n, 2) = t2(i, 2)
End If
Next i
f2.Range("T17").Resize(UBound(a), 2) = a
End Sub