Sub test()
Dim i As Integer, j As Integer
Dim VarTab() As String
Set plage = ActiveSheet.UsedRange.Columns(1).Cells
ReDim VarTab(1 To 2, 1 To 1)
For Each cel In plage
parcours = 1
n = 0
bernard = cel.Offset(0, 6).Value
FinTab = UBound(VarTab, 2)
Do Until parcours > FinTab
If bernard = VarTab(1, parcours) Then
If bernard = "" Then
VarTab(2, parcours) = 1
Else
VarTab(2, parcours) = VarTab(2, parcours) + 1
End If
Else
n = n + 1
If n = UBound(VarTab, 2) Then
ReDim Preserve VarTab(1 To 2, 1 To (n + 1))
VarTab(1, n) = bernard
VarTab(2, n) = 1
End If
End If
parcours = parcours + 1
Loop
Next
For i = 1 To FinTab
Cells(2, i + 9).Value = VarTab(1, i)
Cells(3, i + 9).Value = VarTab(2, i)
Next
End Sub