Sub Поправить_таблицу()

    Dim dTimer As Double: dTimer = Timer

    Dim r_2_Del As Range

    Application.ScreenUpdating = False

    For r = Cells(65536, 2).End(xlUp).Row To 2 Step -1

        Set rn = Cells(r, 1)
        Set RE = Cells(r, 2)

        With rn

            If rn Like "(* - *)" Then

                .Offset(-1, 6).Value = .Offset(-1, 5).Value

            '     .Offset(-1, 5).Value = .Offset(0, 0).Value ' похоже очень сильное колдунство :-)
                
                .Offset(-1, 5).Value = Mid$(rn, 2, Len(rn) - 2)

                .Offset(-1, 7).Value = .Offset(0, 2).Value

                .Offset(-1, 8).Value = .Offset(0, 3).Value

                .Offset(-1, 9).Value = .Offset(0, 4).Value

                Set r_2_Del = App_Union(r_2_Del, .Resize(, 10))

            End If

            If IsEmpty(rn) Then

                If IsEmpty(RE) Then

                    Set r_2_Del = App_Union(r_2_Del, .Resize(, 10))

                End If
            End If

        End With

    Next r

    If Not r_2_Del Is Nothing Then r_2_Del.Delete xlShiftUp

    Application.ScreenUpdating = True

    Application.StatusBar = vbNullString

    MsgBox Timer - dTimer, vbOKOnly, "Всё!"

End Sub

Public Function App_Union(rng_Union As Range, _
        ByVal rng As Range) _
        As Range
    ' тестом Покрыто опосредованно
    ' Вызов:  Set rng_union = App_Union(rng_union, rng)
    ' АртеФакт

    If Not rng_Union Is Nothing Then

        Set App_Union = Application.Union(rng_Union, rng)

    Else

        Set App_Union = rng

    End If
End Function