[Alex Dark]

1 Гламур проще сделать руками
2 Ошибочек нет. У тебя пустые поля "Клуб". Они вносят неразбериху. Но вобщем ты прав, учел вариант пустого поля "Клуб"
3 можкшь убрать. Я их вывел только для проверки

Скрытых строк нет. Ошибся. Но как практика показывает, скрытые строки дают большую погрешность.

Замени

Sub Итоги()
    Dim МояСтрока1, МояСтрока2
    Sheets("Ступени").Select
    МояСтрока1 = 3
    Do While (Not IsEmpty(Sheets("Список").Cells(МояСтрока1, 2)))
        МояСтрока2 = 5
        НеНашли = True
        Do While (Not IsEmpty(Sheets("Ступени").Cells(МояСтрока2, 6)))
            If Sheets("Список").Cells(МояСтрока1, 3).Value = Sheets("Ступени").Cells(МояСтрока2, 3).Value Then
                
                If IsNumeric(Sheets("Список").Cells(МояСтрока1, 38)) Then
                    If Sheets("Список").Cells(МояСтрока1, 38).Value <= 9 Then
                        '   бронза
                        Sheets("Ступени").Cells(МояСтрока2, 7) = Sheets("Ступени").Cells(МояСтрока2, 7).Value + 1
                    
                    ElseIf Sheets("Список").Cells(МояСтрока1, 38).Value <= 13 Then
                        '   Серебро
                        Sheets("Ступени").Cells(МояСтрока2 + 1, 7) = Sheets("Ступени").Cells(МояСтрока2 + 1, 7).Value + 1
                    ElseIf Sheets("Список").Cells(МояСтрока1, 38).Value <= 15 Then
                        '   Золото
                        If МояСтрока2 = 35 Then
                        a1 = 1
                        End If
                        Sheets("Ступени").Cells(МояСтрока2 + 2, 7) = Sheets("Ступени").Cells(МояСтрока2 + 2, 7).Value + 1
                    Else
' Эту строку можно заремарить, Она считает в дополнительной колонки "неувязки"
Sheets("Ступени").Cells(МояСтрока2 + 2, 8) = Sheets("Ступени").Cells(МояСтрока2 + 2, 8).Value + 1
                    End If
                Else
' Эту строку можно заремарить, Она считает в дополнительной колонки "неувязки"
Sheets("Ступени").Cells(МояСтрока2 + 2, 8) = Sheets("Ступени").Cells(МояСтрока2 + 2, 8).Value + 1
                End If
                '   нашли
                НеНашли = False
            End If
            
            МояСтрока2 = МояСтрока2 + 3
        Loop
        If НеНашли Then
            'Sheets("Ступени").Select
            Sheets("Ступени").Range(Sheets("Ступени").Cells(МояСтрока2, 3), Sheets("Ступени").Cells(МояСтрока2 + 2, 3 + 2)).Select
            Selection.Merge

            '   Далее форматирование вновь созданной ячейки. Я поставил обход. Так быстрее
            GoTo mmm
            With Selection
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = True
            End With
mmm:
            Sheets("Ступени").Cells(МояСтрока2, 3).Value = Sheets("Список").Cells(МояСтрока1, 3).Value
            Sheets("Ступени").Cells(МояСтрока2, 6).Value = "Бронза"
            Sheets("Ступени").Cells(МояСтрока2 + 1, 6).Value = "Серебро"
            Sheets("Ступени").Cells(МояСтрока2 + 2, 6).Value = "Золото"
            
            If IsNumeric(Sheets("Список").Cells(МояСтрока1, 38)) Then
                If Sheets("Список").Cells(МояСтрока1, 38).Value <= 9 Then
                    '   бронза
                    Sheets("Ступени").Cells(МояСтрока2, 7) = Sheets("Ступени").Cells(МояСтрока2, 7).Value + 1
                
                ElseIf Sheets("Список").Cells(МояСтрока1, 38).Value <= 13 Then
                    '   Серебро
                    Sheets("Ступени").Cells(МояСтрока2 + 1, 7) = Sheets("Ступени").Cells(МояСтрока2 + 1, 7).Value + 1
                ElseIf Sheets("Список").Cells(МояСтрока1, 38).Value <= 15 Then
                    '   Золото
                    Sheets("Ступени").Cells(МояСтрока2 + 2, 7) = Sheets("Ступени").Cells(МояСтрока2 + 2, 7).Value + 1
                Else
' Эту строку можно заремарить, Она считает в дополнительной колонки "неувязки"
Sheets("Ступени").Cells(МояСтрока2 + 2, 8) = Sheets("Ступени").Cells(МояСтрока2 + 2, 8).Value + 1
                End If
            Else
' Эту строку можно заремарить, Она считает в дополнительной колонки "неувязки"
Sheets("Ступени").Cells(МояСтрока2 + 2, 8) = Sheets("Ступени").Cells(МояСтрока2 + 2, 8).Value + 1
            End If
            'Sheets("Список").Select
            МояСтрока2 = МояСтрока2 + 3
            
        End If
        МояСтрока1 = МояСтрока1 + 1
    Loop
            
    Sheets("Список").Select
End Sub