É exatamente isso que preciso ,agora vou tentar entender o código pra ver como ajustar e adaptar , por exemplo : no modelo as linhas "originais" estão permanecendo visiveis ; mas é isto agora é quebrar a cabeça aqui.

Claudinei, não entendi qdo diz "no modelo as linhas "originais" estão permanecendo visiveis".

No anexo deixei a aba "RSE_Original" que me serviu de modelo, foi só para poder compar se o resultado na Aba RSE era o previsto.

No momento estou bem atarefado, e ainda não da para eu comentar toda a rotina, mas algumas variaveis teem os nomes sugestiveis, como :
lRowIni = 8 - Linha Inicio
sLinInsert = 2 - Linha a Inserir
sLinRetorno - Linha para o retorno

[]s

Claudinei, não entendi qdo diz "no modelo as linhas "originais" estão permanecendo visiveis".

No anexo deixei a aba "RSE_Original" que me serviu de modelo, foi só para poder compar se o resultado na Aba RSE era o previsto.

No momento estou bem atarefado, e ainda não da para eu comentar toda a rotina, mas algumas variaveis teem os nomes sugestiveis, como :
lRowIni = 8 - Linha Inicio
sLinInsert = 2 - Linha a Inserir
sLinRetorno - Linha para o retorno

[]s

Linhas originais neste caso me refiro às linhas de 8 a 14 da aba RSE , tenho que fazer ficar visivel somente as "linhas classificadas"
É , alguns códigos estou conseguindo decifrar pra que servem ou ao menos a que se referem , mas tudo ; éh só com os comentários mesmo .
Mas ao menos agora tenho um norte pra onde quebrar a cabeça.
Por hora muito obrigado , e pode ficar tranquilo que vou te perturbar muito ainda.

Claudinei para Ocultar as Linhas que se referiu apos a Classificação, substitua a Rotina pela a abaixo, resolvi colocar completa devido aos comentarios que fiz na mesma :

Sub Classifica_RSE()
    Dim wsa As Worksheet
    Set wsa = Sheets("RSE")
    Dim sRange As Range
    Dim flin As Long
    
    'Qde de Itens na coluna A
    'Precisava de ter uma referencia, e a numeração
    'nesta coluna propiciou esta implementação para definir os dados na Coluna G
    flin = wsa.Range("A65000").End(xlUp).Row
    
    Dim OCOLLECTION As New Collection 'Cria o Objeto Collection, veja na ajuda do VBA a definição e exemplo
    Dim VARVALUE As Variant 'Itens a armazenar
    Dim cSort As Collection 'Cada item armazenado em OCOLLECTION
    
    Dim lRowIni As Long 'Linha Inicial, em seu modelo começa na linha 8
    Dim sLinRetorno As Long 'Linha para colocar os resultados
    
    Dim sLinInsert 'Linhas a Inserir
    Dim sTemp, sTemp1 As Currency 'Define as Variaveis com Valores Moeda
    Dim sItem
    Dim sValor As Variant
    
    Dim X
    
    lRowIni = 8 'Linha Inicial, em seu modelo começa na linha 8
    sLinInsert = 2 'Qde de Linhas a inserir
    
    'Qde de Itens na coluna A + 2
    'Conta as Linhas e soma mais 2 para efetuar os lançamentod
    sLinRetorno = wsa.Range("A65000").End(xlUp).Row + 2
    
    'Definição do Range
    Set sRange = Range("G" & lRowIni & ":G" & flin)

    X = 2
    
        On Error Resume Next
        'Armazena os valores em OCOLLECTION
        For Each VARVALUE In sRange
                OCOLLECTION.Add CStr(VARVALUE), CStr(VARVALUE)
                X = X + 1
        Next
        
        'Classifica os valores em Collection
        Set cSort = SortCollection(OCOLLECTION)
        Dim sSort
    
        Application.ScreenUpdating = False
    
        sItem = cSort.Count - 1
    For Each sSort In cSort
        
        For Each sValor In sRange
            If sSort = wsa.Range("G" & lRowIni).Value Then
                wsa.Range("B" & lRowIni & ":O" & lRowIni).Copy Destination:=wsa.Cells(sLinRetorno, 2)
                
                sTemp = wsa.Cells(lRowIni, 6)
                
                sLinRetorno = sLinRetorno + 1
                sTemp1 = sTemp1 + sTemp
                wsa.Cells(sLinRetorno, 1).EntireRow.Insert
            End If
            
            lRowIni = lRowIni + 1
            
        Next
            lRowIni = 8
         
            wsa.Cells(sLinRetorno, 3).Value = "TOTAL PARA A LOCALIDADE"
            wsa.Cells(sLinRetorno, 4).Value = sSort
            wsa.Cells(sLinRetorno, 6).Value = sTemp1
            
            wsa.Cells(sLinRetorno, 3).Resize(1, 5).Font.Bold = True
        
        'Enquanto a variavel for menor que 1 insere a linha
        'Como definimos acima esta qde como 2, insere somente as duas linhas
        'e depois sai darotina ao atingir a qde, redirecionando para o final, ondde ocultamos as linhas
        If sItem = 0 Then GoTo Fim
            Do Until sLinInsert < 1
               wsa.Cells(sLinRetorno, 1).Offset(2, 0).EntireRow.Insert shift:=xlDown
               'Move uma linha acima
                 sLinInsert = sLinInsert - 1
            Loop
            
            sItem = sItem - 1
            sLinInsert = 2
            sLinRetorno = sLinRetorno + 2
        
        sTemp1 = 0
        
    Next sSort
    
Fim:

'Oculta as Linhas
sRange.EntireRow.Hidden = True

End Sub

E na rotina que apaga os lançamentos, utilize a rotina abaixo pra depois que apagar, reexibir as linhas:

    Sub Del_Linhas()
        Dim sRange As Range
        Dim sRowInicio As Long
        Dim FinalRow As Long
        Dim wsa As Worksheet
        Set wsa = Sheets("RSE")
       
        'Verifica a última linha preenchida
        FinalRow = wsa.Range("C65536").End(xlUp).Row '- 2
       
        'Linha Inicial, onde se iniciou os lançamentos
        sRowInicio = 16
       
       'Verifica antes se tem lançamentos, se não tiver sai da rotina
        If wsa.Range("B" & sRowInicio).Value = "" Then
            Exit Sub
        End If
        
        'Se tiver lançamentos, definimos o Range
        Set sRange = wsa.Range("A" & sRowInicio & ":A" & FinalRow)

            'Deleta as Linhas
            sRange.EntireRow.Delete
            
            'Insere uma linha
            wsa.Cells(sRowInicio, 1).EntireRow.Insert
            wsa.Range("A" & sRowInicio & ":O" & sRowInicio).Interior.ColorIndex = 2
            
            'Reexibe as linhas
            wsa.Range("A8" & ":O" & sRowInicio).EntireRow.Hidden = False
            
    End Sub

Uma sugestão, não querendo alterar o seu projeto, porque não joga o resultado para uma nova aba ?

[]s

"Uma sugestão, não querendo alterar o seu projeto, porque não joga o resultado para uma nova aba ?"

É que modifiquei para ora fazer a classificacao por cidade ora por alimentador , pra gerar nova aba teria que gerar 2 novas abas e acho que numa só ficara com aparencia melhor e o arquivo menor.

O problema que estou encontrando agora é :

na Sub Del_Linhas()

'Linha Inicial, onde se iniciou os lançamentos
sRowInicio = 16

Essa linha nem sempre vai ser a 16; Depende de quantos lançamentos houver no "original" ;como fazer para torna-la variavel?

Claudinei, eu nã criei uma variavel para esta Instrução, porque eu não achei que você iria usa-la, construi só para evitar de ficar deletando as linhas quando eu estava fazendo testes.
Mas se vai utiliza-la, para criar uma Variavel para a linha em questão, faça o seguinte :

No Modulo onde estão estas rotinas, coloque na Declaração do Modulo, ou seja no inicio antes de qq rotina, a declaração da Variável "sContInicio" :

Dim sContInicio As Long

Depois, na Rotina "Sub Classifica_RSE", após a instrução :
sLinRetorno = wsa.Range("A65000").End(xlUp).Row + 2
Adicione :
sContInicio = sLinRetorno

Feito isto, na rotina "Sub Del_Linhas()", troque a isntrução :
sRowInicio = 16
Por:
sRowInicio = sContInicio

Faça os testes e qq duvida retorne.

[]s

Valeu Mauro fui fazendo adaptações e deu certo a classificação , poderia dar uma olhada no tópico
viewtopic.php?f=10&t=3985.

Muitissimo obrigado a vc e a todos que colaboraram.