Sub Групп()
Application.ScreenUpdating = False
Dim i As Long
For i =  1  To Cells(Rows.Count, "B").End(xlUp).Row Step  1 
If Cells(i,  2 ).Font.Size =  10  Then
Rows(i).Group
Rows(i).Group
End If
Next i
End Sub

Sub Групп()
Application.ScreenUpdating = False
Dim i As Long
Dim r As Range
For i =  1  To Cells(Rows.Count, "B").End(xlUp).Row Step  1 
If Cells(i,  2 ).Font.Size =  10  Then
Set r = Rows(i)
Select Case r.OutlineLevel
    Case  1 
        r.Group
        r.Group
    Case  2 
        r.Group
End Select
End If
Next i
End Sub