Sub tt()
    z_ = "выполнено" 'метка для проверки
    r0_ = 4 'первая строка данных листа План
    c_ = 9 'сколько столбцов брать. Можно Cells(r0_, Columns.Count).End(1).Column
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1 'кол-во заполненных строк в столбце с_
    If n_ < 1 Then Exit Sub 'если от не заполнен, то выход
    ar = Cells(r0_, 1).Resize(n_, c_) 'все данные берем в массив
    For i = 1 To n_ 'цикл по строкам
        If ar(i, c_) = z_ Then 'если последний столбец равен метке
            k_ = k_ + 1 'счётчик +1
            If k_ <> i Then 'номер счетчика не равен номеру в цикле
                For j1 = 1 To 5 'цикл по первым 5-и столбцам
                    ar(k_, j1) = ar(i, j1) 'заменяем в массиве первые 5 столбцов строки k на 5 столбцов строки i ***
                Next j1
            End If
            For j2 = 7 To c_ ''цикл по 7 и правее столбцам
                ar(k_, j2 - 1) = ar(i, j2) '*** со смещением на один столбец влево
            Next j2
        End If
    Next i
    If k_ > 0 Then 'если счетчик есть
        With Sheets("Отчет ") 'для листа Отчет (зачем Вы сделали в названии листа пробел?)
            r00_ = 4 'первая строка
            c00_ = 1 'первый столбец
            n00_ = .Cells(Rows.Count, c00_).End(3).Row - r00_ + 1 'кол-во заполненных строк в столбце с00_
            If n00_ > 0 Then 'если есть уже какие-то строки
                .Cells(r00_, c00_).Resize(n00_, c_ - 1).Clear 'убиваем их
            End If
            With .Cells(r00_, c00_).Resize(k_, c_ - 1) 'с ячейки r00_, c00_ вниз на k_ и вправо на с_-1
                .Value = ar 'вставляем КУСОК из массива ar (на самом деле он у нас вероятно будет больше)
                .Borders.Weight = xlThin 'рисуем границы
            End With
            .Select 'переходим на лист
        End With
    End If
End Sub

Sub tt()
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    z_ = "выполнено" 'метка для проверки
    r0_ = 4 'первая строка данных листа План
    c_ = 9 'сколько столбцов брать. Можно Cells(r0_, Columns.Count).End(1).Column
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1 'кол-во заполненных строк в столбце с_
    If n_ < 1 Then Exit Sub 'если от не заполнен, то выход
    ar = Cells(r0_, 1).Resize(n_, c_) 'все данные берем в массив
    With Sheets("Отчет ") 'для листа Отчет (зачем Вы сделали в названии листа пробел?)
        r00_ = 4 'первая строка
        c00_ = 1 'первый столбец
        n00_ = .Cells(Rows.Count, c00_).End(3).Row - r00_ + 1 'кол-во заполненных строк в столбце с00_
        If n00_ > 0 Then 'если есть уже какие-то строки
            .Cells(r00_, c00_).Resize(n00_, c_ - 1).Clear 'убиваем их
        End If
        For i = 1 To n_ 'цикл по строкам
            If ar(i, c_) = z_ Then 'если последний столбец равен метке
                k_ = k_ + 1 'счётчик +1
                Cells(r0_ + i - 1, 1).Resize(1, c_).Copy .Cells(r00_ + k_ - 1, 1).Resize(1, c_)
            End If
        Next i
        .Cells(r00_, 6).Resize(k_).Delete Shift:=xlToLeft
        .Select
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub