Bom dia!!

Tente algo assim..

Option Explicit

Sub AleVBA_16244()
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
        With Worksheets("Plan1").Range("$A$1")
            .AutoFilter field:=1, Criteria1:=Array("Total OL + Negociados", "Totais", "Total"), Operator:=xlFilterValues
            .Resize(Rows.Count - 1).Offset(1).EntireRow.Delete
        End With
        ActiveSheet.AutoFilterMode = False
    
        [E1].Value = "AleVBA"
        [F1].Value = "Total OL + Negociados"
        [J1].Value = "Total"
        [N1].Value = "Totais"
        Range("E2").Formula = "=IF(OR(LEFT(B2,3)=""NEG"",LEFT(B2,2)=""OL""),1,0)"
        Range("E2").AutoFill Destination:=Range("E2:E" & lastrow)
        Range("E2:E" & lastrow).Value = Range("E2:E" & lastrow).Value
            With Worksheets("Plan1")
            'Total OL + Negociados
                .Range("A1:E" & lastrow).AutoFilter field:=5, Criteria1:=1
                [I1].Formula = "=SUBTOTAL(9,R2C4:R1000C4)"
                [I1].Value = [I1].Value
                .AutoFilterMode = False
            'Total
                .AutoFilterMode = False
                .Range("A1:E" & lastrow).AutoFilter field:=5, Criteria1:=0
                [M1].Formula = "=SUBTOTAL(9,R2C4:R1000C4)"
                [M1].Value = [M1].Value
                .AutoFilterMode = False
            'Totais
                [Q1].Formula = "=SUM(D:D)"
                [Q1].Value = [Q1].Value
                'Prepara os totais e subtotais
                .Range("F1:I1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                .Range("J1:M1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                .Range("N1:Q1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                .Columns("E:Q").EntireColumn.Delete
            End With
    Application.ScreenUpdating = True
End Sub

Boa noite,

Alexandre, isso mesmo que estava procurando, gostaria apenas de mais uma ajuda, que ao final do codigo as linhas que estao de amarelo ( que sao as que possuem as palavras "NEG" ou "OL" fossem deletas ou ocultadas da planilhas, tentei acrescentar algo aqui no código, mas nada deu certo, sera que poderia me auxiliar nesse restante, desde ja muito obrigado, ja me ajudou bastante.

Bom dia!!

Veja se isso ajuda.

Option Explicit

Sub AleVBA_16244V2()
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
        With Worksheets("Plan1").Range("$A$1")
            .AutoFilter field:=1, Criteria1:=Array("Total OL + Negociados", "Totais", "Total"), Operator:=xlFilterValues
            .Resize(Rows.Count - 1).Offset(1).EntireRow.Delete
        End With
        ActiveSheet.AutoFilterMode = False
        [E1].Value = "AleVBA"
        [F1].Value = "Total OL + Negociados"
        [J1].Value = "Total"
        [N1].Value = "Totais"
        Range("E2").Formula = "=IF(OR(LEFT(B2,3)=""NEG"",LEFT(B2,2)=""OL""),1,0)"
        Range("E2").AutoFill Destination:=Range("E2:E" & lastrow)
        Range("E2:E" & lastrow).Value = Range("E2:E" & lastrow).Value
            With Worksheets("Plan1")
            'Total OL + Negociados
                .Range("A1:E" & lastrow).AutoFilter field:=5, Criteria1:=1
                [I1].Formula = "=SUBTOTAL(9,R2C4:R1000C4)"
                [I1].Value = [I1].Value
                '
                .AutoFilterMode = False
            'Total
                .AutoFilterMode = False
                .Range("A1:E" & lastrow).AutoFilter field:=5, Criteria1:=0
                [M1].Formula = "=SUBTOTAL(9,R2C4:R1000C4)"
                [M1].Value = [M1].Value
                .AutoFilterMode = False
            'Totais
                [Q1].Formula = "=SUM(D:D)"
                [Q1].Value = [Q1].Value
                'Prepara os totais e subtotais
                .Range("F1:I1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                .Range("J1:M1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                .Range("N1:Q1").Copy Destination:=.Range("A60000").End(xlUp).Offset(1, 0)
                'Deleta as linhas em Amarelo
                With Columns("E")
                    .AutoFilter field:=1, Criteria1:=1
                    .Resize(Rows.Count - 1).Offset(1).EntireRow.Delete
                End With
                .Columns("E:Q").EntireColumn.Delete
            End With
    Application.ScreenUpdating = True
End Sub

Muito Obrigado Alexandre, resolveu meu problema. valeu mesmo.