Sub Кнопка1_Щелчок()
Dim LastRow As Long, Rw As Long '
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Онега")
        Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rw = 10
        For i = 2 To LastRow
            If Cells(i, 9) = "Онега-строй" Then
                Range(Cells(i, 6), Cells(i, 6)).Copy .Cells(Rw, 7)
                Range(Cells(i, 2), Cells(i, 3)).Copy .Cells(Rw, 2)
                Rw = Rw + 1
            End If
        Next

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Set r = Application.Intersect(Range("C2"), Target)
If Not r Is Nothing Then
If MsgBox("Пометить на удаление", vbOKCancel) = vbOK Then
ActiveWorkbook.Worksheets("Отчет").Range(Cells(2, 1), Cells(2, 24)).Interior.Color = vbRed
End If
End If

End Sub