Ljrbrasil,

Não sei se entendi direito o que quer fazer, mas segue anexo um modelo do que compreendi a respeito do que quer.

Dê retorno.

Sds,

Henrique Ronconi

Amigo
hronconi

É exatamente isto que preciso, mas poderia me orientar (comentando a macro) para que eu possa adaptar a minha real necessidade.

fico grato.

Conforme solicitado segue comentários sobre código:

Sub MontaForma()
' Declaração de variáveis
    Dim rng As Range
    Dim nl As Boolean
    Dim sm1 As Double, sm2 As Double, sm3 As Double, sm4 As Double

'Atribuição dos valores às variáveis de controle
    nl = False
    
'Verificação se o processo já foi executado no arquivo para não executar novamente sobre dados já ordenados
    If Range("I1").Value = "Feito" Then
        MsgBox ("Processo já efetuado nestes dados, faça nova cópia de dados da planilha 2 para executar novamente")
        Exit Sub
    End If
 'Desliga a atualização do monitor
     Application.ScreenUpdating = False
    
 'Insere uma coluna com uma fórmula para verificar se registro está com valor de INATIVO na coluna B (linha amarela), _
    se estiver INATIVO atribui o valor VERDADEIRO senão FALSO
    Columns("A:A").Select
    Selection.Insert shift:=xlToRight, copyorigin:=xlFormatFromLeftOrAbove
    Range("A1").FormulaR1C1 = _
        "=OR(IF(RC[2]=""INATIVO"",TRUE,FALSE),AND(R[1]C[1]=RC[1],R[1]C=TRUE))"
    Range("A1").Copy Destination:=Range("A2:A267")
    Application.CutCopyMode = False
    
' Faz uma verificação em cada célula da coluna A (criada acima) para verificar se é verdadeiro ou falso
    For Each rng In Range("A:A")
        'Verifica se o controle para inserir nova linha está ligado ou desligado, caso VERDADEIRO então insere nova linha e atribui o valor das _
        variáveis de soma às células das colunas C,D,E,F da linha corrente e zera variáveis de soma
        If nl = True Then
            rng.EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
            rng.Offset(-1, 3).Value = sm1
            rng.Offset(-1, 4).Value = sm2
            rng.Offset(-1, 5).Value = sm3
            rng.Offset(-1, 6).Value = sm4
            rng.Offset(-1, 1).Value = rng.Offset(-2, 1).Value
            nl = False
            sm1 = 0
            sm2 = 0
            sm3 = 0
            sm4 = 0
        End If
        'Verifica se a célula tem valor VERDADEIRO, caso afirmativo atribui os valores das colunas C,D,E,F na linha corrente para as _
         variáveis de soma.
        If rng.Value = True Then
            sm1 = sm1 + rng.Offset(0, 3).Value
            sm2 = sm2 + rng.Offset(0, 4).Value
            sm3 = sm3 + rng.Offset(0, 5).Value
            sm4 = sm4 + rng.Offset(0, 6).Value
        End If
        
        'Verifica se a célula tem valor VERDADEIRO, caso afirmativo compara os valores das células da coluna B da linha corrente com o _
        valor da célula de baixo. Se os valores forem difentes ou se o valor da célula de baixo referente a coluna A for FALSO então _
        atribui a variável de controle para inserção de nova linha
        If rng.Value = True And (rng.Offset(0, 1).Value <> rng.Offset(1, 1).Value Or rng.Offset(1, 0).Value = False) Then nl = True
        If rng.Value = "" Then Exit For
    Next rng
    
'Copia e cola como valores para que as células que contém fórmulas não percam o seu conteúdo durante o processamento de exclusão de linhas
    Columns("A:A").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
'Vai para rotina de exclusão das linhas que contém VERDADEIRO na coluna A
    DeleteRowsWithWord
    
'Deleta a coluna auxiliar A
    Range("A:A").EntireColumn.Delete
    
'Atribui o valor Feito na célula I1 da planilha para evitar que a rotina seja executada em cima de dados já processados.
    Range("I1").Value = "Feito"
    
'Libera a atualização no monitor
    Application.ScreenUpdating = True
End Sub


Sub DeleteRowsWithWord()
    Dim Col As Integer, Word As Variant
    Let Col = 1
    Let Word = True
    With Columns(Col)
        .Replace Word, "#N/A", xlWhole
        .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    End With
End Sub
 

Somar e Excluir

Enviado: Hoje, 20:35
De: Ljrbrasil
Para: hronconi

Hronconi,

Primeiramente gostaria de agradece pela ajuda e dizer que é exatamente o que precisava.

Mas acho que minha planilha de exemplo não foi como deveria ( uma vez que exclui algumas colunas o que acabou interferindo).

Você postou o codigo comentado mas posso lhe dizer que sou amador e não tenho muita pratica. gostaria de ver a possibilidade de uma nova ajuda no codigo com a planilha do link em anexo. Estou lhe enviando aqui pois vou esta expondo a informação que vou trabalhar e não gostaria de expor.

http://www.sendspace.com/file/vv1yv7

O grande detalhe que percebi e que você fez o comparativo de inativo e ativo porem tem varias nomenclarutras dentro da planilha.

POS
PRE
PREWEB
TIMWEB

e a ideia e sempre somar nas linhas de pre.

bom fico grato de puder me ajudar

CUIDADO COM OS ARQUIVOS QUE ESTE USUÁRIO Ljrbrasil ENVIA. PODE SER VÍRUS!!!!!!!! NÃO EXECUTEM O ARQUIVO DO LINK ACIMA.

Esclarecimento.

Pessoal bom dia!

Conforme informações do nosso amigo hronconi, pedia a ele uma ajuda de um tópico já considerado resolvido por mensagem particular pois minha planilha continha informações e dados pessoais de minha empresa.

Exclui o link de download pelo mesmo motivo e vi que ele notificou o arquivo como virus, porem sempre utilizo o foruns e as ajuda são sempre muito uteis.

Peço desculpa se o arquivo pareceu malicioso.

me encontro a disposição com os administradores do foruns ou qualquer outra que julgue necessário.

At.te

Ljrbrasil

Não quero ser responsável por cometer uma injustiça, portanto faço aqui publicamente uma retratação a respeito do assunto:

O arquivo anexado pelo usuário Ljrbrasil estava em um site fora do fórum e continha várias mensagens de DOWNLOAD, uma delas era do próprio arquivo que ele anexou (e eu não encontrei naquele primeiro momento), mas várias outras (tanto acima como abaixo) correspondiam a outro arquivo chamado SaveAs.EXE como podem verificar na Imagem 2.

Quando baixei o arquivo o meu antivírus alertou sobre o mesmo e então foi que decidí fazer uma varredura através do site VIRUTOTAL, que também acusou possível vírus.

Portanto não foi culpa do usuário Ljrbrasil, nem tampouco minha, apenas um mal entendido que espero que esteja resolvido.

Caso o usuário ainda queira que seja prestado suporte para sua necessidade, me coloco a disposição.

Sinceramente,

Henrique Ronconi