Macro relatorio de perdas e roubos

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

Olá gente, devido a demanda estar aumentando eu estou gerando um relatorio de perdas e roubos, que são produtos que apresentam defeitos (devolvidos) e produtos faltando em estoque (roubo) quando fazemos a conferencia. eu consegui através de um codigo que ja tinha sido feito fzer grande parte das coisas porém nao consegui fazer tudo que gostaria.

No caso no código ele verifica se tem dados em na coluna N linha 8 e copia as colunas M,N,O,Q,R,S e a celula J4 (que é onde fica o nome da empresa), e vi colar na aba perdas e roubos de acordo com su devida coluna. Esse do J4 ele não tá copiando =/
No caso a macro precisaria recortar os dados além da coluna N linha 8 em diante, também se tiver dados na coluna R linha 8, pois sao relatorios diferentes para ser copiado, pois um é de defeitos "N" e outro é de roubos "R". isso sempre copiando o nome da aba, e a celula j4.

Além disso eu gostaria que ele não substituisse os dados em "Perdas e Roubos" ele teria que continuar colando abaixo de onde tiver em branco. E por fim ao invés de COPIAR, ele teria que RECORTAR os dados, ou seja ele teria que apagar as informações das demais abas e deixar apenas na aba de "perdas e roubos".

aqui esta a planilha no drive: https://drive.google.com/open?id=1anTG7 ... Bf87exUD1A

e eis o código que eu tava fazendo as alterações:

Sub Perdasefaltas()
    '=========================================================================================
    'Código VBA desenvolvido por Wagner Morel, em 15/07/2017, para kayomaster, integrante do _
    do fórum planilhando, para Gerar relatório de Pedido dos Mercadinhos
    '=========================================================================================
    'Declaração de variáveis
    Dim i As Long
    Dim j As Long
    Dim UltimaLinha As Long
    Dim Linha As Long
    
    'Desabilita atualizações de tela
    Application.ScreenUpdating = False
    
    'Atribui a linha 3 como sendo a primeira da aba Pedidos
    Linha = 4
    
    'Limpa a aba Pedidos
    'Pega a última linha com dados da aba Pedidos pela coluna A
    UltimaLinha = Sheets("pedidos").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    'Certifica-se que os dados comecem na linha 2
    If UltimaLinha < 8 Then UltimaLinha = 8
    'Seleciona a aba Pedidos
    Sheets("PERDAS & ROUBOS").Select
       'Seleciona a célula A1
    Range("A1").Select
    'Volta para a aba Geral
    Sheets("GE").Select
    
    'Laço para percorrer todas as abas
    For j = 1 To Sheets.Count
        'Verifica o nome das abas e exclui as que não interessam
        If Sheets(j).Name <> "GE" And Sheets(j).Name <> "Planilha" And Sheets(j).Name <> "Imprimir" And Sheets(j).Name <> "CB" And Sheets(j).Name <> "pedidos" And Sheets(j).Name <> "C & C" And Sheets(j).Name <> "V & L" And Sheets(j).Name <> "EVOL." And Sheets(j).Name <> "V. IND" And Sheets(j).Name <> "EST" And Sheets(j).Name <> "recibo" And Sheets(j).Name <> "CAD." And Sheets(j).Name <> "VENDAS A PRAZO" And Sheets(j).Name <> "PERDAS & ROUBOS" And Sheets(j).Name <> "FOR." And Sheets(j).Name <> "PR E ESTQ" And Sheets(j).Name <> "HISTORICO" And Sheets(j).Name <> "FORNECEDORES" And Sheets(j).Name <> "121P" And Sheets(j).Name <> "122P" And Sheets(j).Name <> "123P" And Sheets(j).Name <> "124P" And Sheets(j).Name <> "125P" And Sheets(j).Name <> "ImprimirPRE" And Sheets(j).Name <> "reciboPRE" And Sheets(j).Name <> "EVOL2" And Sheets(j).Name <> "CB" Then
            'Seleciona a aba que interessa
            Sheets(j).Select
            'Pega a última linha com dados da aba ativa pela coluna A
            UltimaLinha = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
            'Certifica-se que os dados comecem na linha 4
            If UltimaLinha < 8 Then UltimaLinha = 8
            'Laço para percorrer todas as linhas da planilha ativa
            For i = 9 To UltimaLinha
                'Verifica se a coluna D contém alguma coisa
                If Range("N" & i).Value <> "" Then
                    'Copia os dados para a aba Pedidos
                    Sheets("PERDAS & ROUBOS").Range("A" & Linha).Value = ActiveSheet.Name
                    Sheets("PERDAS & ROUBOS").Range("B" & Linha).Value = ActiveSheet.Range("M" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("C" & Linha).Value = ActiveSheet.Range("N" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("D" & Linha).Value = ActiveSheet.Range("O" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("F" & Linha).Value = ActiveSheet.Range("Q" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("G" & Linha).Value = ActiveSheet.Range("R" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("H" & Linha).Value = ActiveSheet.Range("S" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("E" & Linha).Value = ActiveSheet.Range("J4" & i).Value
                    'Incrementa a linha da aba Pedidos
                    Linha = Linha + 1
                End If
            Next
        End If
    Next
    'Exibe mensagem de sucesso
    MsgBox "GERADO RELATÓRIO DE PERDAS!", vbDefaultButton1, "PERDAS E ROUBOS"
    'Volta para a aba Geral
    Sheets("PERDAS & ROUBOS").Select
    'Volta a habilitar as atualizações de tela
    Application.ScreenUpdating = True
End Sub

desde já agradeço o apoio e ajuda de todos vocês.

Postado : 06/05/2018 7:51 am

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

oi gente! bem eu fui vendo outras possibiulidades de conseguir o que queria e a rotina est quase pronta, fiz duas formulas uma so pra copiar os defeitos e outra so pra copiar as perdas, e fiz um para apagar os dados copiados nas abas. sendo que só tem um porem eu nao sei aonde muda pra qundo ele for colar não substituir os dados que ja têm na aba perdas e roubos. há e consegui descobrir que o fato de não est copiado os dados da J4 era só porque tinha "& i" ai reitrei e deu certo. alguem poderia me ajudar? seguem abaixo os codigos:

Sub Relatoriodederoubos()
    '=========================================================================================
    'Código VBA desenvolvido por Wagner Morel, em 15/07/2017, para kayomaster, integrante do _
    do fórum planilhando, para Gerar relatório de Pedido dos Mercadinhos
    '=========================================================================================
    'Declaração de variáveis
    Dim i As Long
    Dim j As Long
    Dim UltimaLinha As Long
    Dim Linha As Long
    
    'Desabilita atualizações de tela
    Application.ScreenUpdating = False
    
    'Atribui a linha 3 como sendo a primeira da aba Pedidos
    Linha = 4
    
    'Limpa a aba Pedidos
    'Pega a última linha com dados da aba Pedidos pela coluna A
    UltimaLinha = Sheets("pedidos").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    'Certifica-se que os dados comecem na linha 2
    If UltimaLinha < 8 Then UltimaLinha = 8
    'Seleciona a aba Pedidos
    Sheets("PERDAS & ROUBOS").Select
       'Seleciona a célula A1
    Range("A1").Select
    'Volta para a aba Geral
    Sheets("GE").Select
    
    'Laço para percorrer todas as abas
    For j = 1 To Sheets.Count
        'Verifica o nome das abas e exclui as que não interessam
        If Sheets(j).Name <> "GE" And Sheets(j).Name <> "Planilha" And Sheets(j).Name <> "Imprimir" And Sheets(j).Name <> "CB" And Sheets(j).Name <> "pedidos" And Sheets(j).Name <> "C & C" And Sheets(j).Name <> "V & L" And Sheets(j).Name <> "EVOL." And Sheets(j).Name <> "V. IND" And Sheets(j).Name <> "EST" And Sheets(j).Name <> "recibo" And Sheets(j).Name <> "CAD." And Sheets(j).Name <> "VENDAS A PRAZO" And Sheets(j).Name <> "PERDAS & ROUBOS" And Sheets(j).Name <> "FOR." And Sheets(j).Name <> "PR E ESTQ" And Sheets(j).Name <> "HISTORICO" And Sheets(j).Name <> "FORNECEDORES" And Sheets(j).Name <> "121P" And Sheets(j).Name <> "122P" And Sheets(j).Name <> "123P" And Sheets(j).Name <> "124P" And Sheets(j).Name <> "125P" And Sheets(j).Name <> "ImprimirPRE" And Sheets(j).Name <> "reciboPRE" And Sheets(j).Name <> "EVOL2" And Sheets(j).Name <> "CB" Then
            'Seleciona a aba que interessa
            Sheets(j).Select
            'Pega a última linha com dados da aba ativa pela coluna A
            UltimaLinha = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
            'Certifica-se que os dados comecem na linha 4
            If UltimaLinha < 8 Then UltimaLinha = 8
            'Laço para percorrer todas as linhas da planilha ativa
            For i = 9 To UltimaLinha
                'Verifica se a coluna D contém alguma coisa
                If Range("N" & i).Value <> "" Then
                    'Copia os dados para a aba Pedidos
                    Sheets("PERDAS & ROUBOS").Range("A" & Linha).Value = ActiveSheet.Name
                    Sheets("PERDAS & ROUBOS").Range("C" & Linha).Value = ActiveSheet.Range("M" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("D" & Linha).Value = ActiveSheet.Range("N" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("E" & Linha).Value = ActiveSheet.Range("O" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("B" & Linha).Value = ActiveSheet.Range("J4").Value
                    'Incrementa a linha da aba Pedidos
                    Linha = Linha + 1
                End If
            Next
        End If
    Next
    'Exibe mensagem de sucesso
    MsgBox "GERADO RELATÓRIO DE FALTAS (ROUBOS)!", vbDefaultButton1, "PRODUTOS FALTANDO"
    'Volta para a aba Geral
    Sheets("PERDAS & ROUBOS").Select
    'Volta a habilitar as atualizações de tela
    Application.ScreenUpdating = True
End Sub
Sub Relatoriodededefeitos()
    '=========================================================================================
    'Código VBA desenvolvido por Wagner Morel, em 15/07/2017, para kayomaster, integrante do _
    do fórum planilhando, para Gerar relatório de Pedido dos Mercadinhos
    '=========================================================================================
    'Declaração de variáveis
    Dim i As Long
    Dim j As Long
    Dim UltimaLinha As Long
    Dim Linha As Long
    
    'Desabilita atualizações de tela
    Application.ScreenUpdating = False
    
    'Atribui a linha 3 como sendo a primeira da aba Pedidos
    Linha = 4
    
    'Limpa a aba Pedidos
    'Pega a última linha com dados da aba Pedidos pela coluna A
    UltimaLinha = Sheets("pedidos").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    'Certifica-se que os dados comecem na linha 2
    If UltimaLinha < 8 Then UltimaLinha = 8
    'Seleciona a aba Pedidos
    Sheets("PERDAS & ROUBOS").Select
       'Seleciona a célula A1
    Range("A1").Select
    'Volta para a aba Geral
    Sheets("GE").Select
    
    'Laço para percorrer todas as abas
    For j = 1 To Sheets.Count
        'Verifica o nome das abas e exclui as que não interessam
        If Sheets(j).Name <> "GE" And Sheets(j).Name <> "Planilha" And Sheets(j).Name <> "Imprimir" And Sheets(j).Name <> "CB" And Sheets(j).Name <> "pedidos" And Sheets(j).Name <> "C & C" And Sheets(j).Name <> "V & L" And Sheets(j).Name <> "EVOL." And Sheets(j).Name <> "V. IND" And Sheets(j).Name <> "EST" And Sheets(j).Name <> "recibo" And Sheets(j).Name <> "CAD." And Sheets(j).Name <> "VENDAS A PRAZO" And Sheets(j).Name <> "PERDAS & ROUBOS" And Sheets(j).Name <> "FOR." And Sheets(j).Name <> "PR E ESTQ" And Sheets(j).Name <> "HISTORICO" And Sheets(j).Name <> "FORNECEDORES" And Sheets(j).Name <> "121P" And Sheets(j).Name <> "122P" And Sheets(j).Name <> "123P" And Sheets(j).Name <> "124P" And Sheets(j).Name <> "125P" And Sheets(j).Name <> "ImprimirPRE" And Sheets(j).Name <> "reciboPRE" And Sheets(j).Name <> "EVOL2" And Sheets(j).Name <> "CB" Then
            'Seleciona a aba que interessa
            Sheets(j).Select
            'Pega a última linha com dados da aba ativa pela coluna A
            UltimaLinha = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
            'Certifica-se que os dados comecem na linha 4
            If UltimaLinha < 8 Then UltimaLinha = 8
            'Laço para percorrer todas as linhas da planilha ativa
            For i = 9 To UltimaLinha
                'Verifica se a coluna D contém alguma coisa
                If Range("R" & i).Value <> "" Then
                    'Copia os dados para a aba Pedidos
                    Sheets("PERDAS & ROUBOS").Range("F" & Linha).Value = ActiveSheet.Name
                    Sheets("PERDAS & ROUBOS").Range("H" & Linha).Value = ActiveSheet.Range("Q" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("I" & Linha).Value = ActiveSheet.Range("R" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("J" & Linha).Value = ActiveSheet.Range("S" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("G" & Linha).Value = ActiveSheet.Range("J4").Value
                    'Incrementa a linha da aba Pedidos
                    Linha = Linha + 1
                End If
            Next
        End If
    Next
    'Exibe mensagem de sucesso
    MsgBox "GERADO RELATÓRIO DE DEFEITOS!", vbDefaultButton1, "DEFEITOS"
    'Volta para a aba Geral
    Sheets("PERDAS & ROUBOS").Select
    'Volta a habilitar as atualizações de tela
    Application.ScreenUpdating = True
End Sub
Sub fncCLEARPERDASEROUBOS()
  Dim wks As Excel.Worksheet
  
  For Each wks In Sheets
    Select Case wks.Name
      Case "MAT.", "100", "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "111", "112", "113", "114", "115", "116", "117", "118", "119", "120"
        wks.Range("M9:020").ClearContents
        wks.Range("Q8:S20").ClearContents
        
        End Select
  Next wks
End Sub

Postado : 09/05/2018 7:50 am

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

oi gente, pra concluir o codigo so esta faltando esse detalhe dele nao subustituir os dados da aba "perdas e roubos" eu tirei algumas linhas de comando mas nao est dndo certo. alguém sabe me informar o que precisa por pra ele apenas ir colando embaixo do que tiver em branco?

Postado : 11/05/2018 8:16 am

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

Precisa identificar a ultima linha com dados na planilha onde os dados vai ser colados.

O codigo que identifica a primeira linha vazia da base de dados é este

Dim ultimalinha as long

ultimalinha = range("A" & rows.count).end(xlup).offset(1,0).row

Ajuste como necessario.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 13/05/2018 3:59 pm

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

mas no caso nunca vai ter uma ultima linha em especifico pois sempre será a linha que estiver em branco. é esse o problema =/
não consegui fazer ...

Postado : 14/05/2018 1:32 pm

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

colooquei o numero zero pra ver se dava certo, apaguei a linha mas nao deu certo. pra ele so preencher na linha que tiver em branco nos caso da rotina

Relatoriodederoubos() no que tiver limpo entre as colunas A até E as linhas que estiverem em branco
e para Relatoriodededefeitos() das colunas F J s linhas que estiverem em branco

            UltimaLinha = Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row

Ainda não consegui....

Postado : 16/05/2018 6:53 pm

klarc28

(@klarc28)

Posts: 971

Prominent Member

É necessário que, além do código para encontrar a última linha, você utilize a variável ultimalinha no Range. Por exemplo:

wks.Range("M9:0"  & ultimalinha).ClearContents
        wks.Range("Q8:S" & ultimalinha).ClearContents

Postado : 17/05/2018 6:24 am

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

olá, eu não consegui entender, aqui esta o codigo de uma das macros no caso das de defeitos

Sub Relatoriodededefeitos()
    '=========================================================================================
    'Código VBA desenvolvido por Wagner Morel, em 15/07/2017, para kayomaster, integrante do _
    do fórum planilhando, para Gerar relatório de Pedido dos Mercadinhos
    '=========================================================================================
    'Declaração de variáveis
    Dim i As Long
    Dim j As Long
    Dim UltimaLinha As Long
    Dim Linha As Long
    
    'Desabilita atualizações de tela
    Application.ScreenUpdating = False
    
    'Atribui a linha 3 como sendo a primeira da aba Pedidos
    Linha = 4
    
    'Limpa a aba Pedidos
    'Pega a última linha com dados da aba Pedidos pela coluna A
    UltimaLinha = Sheets("PERDAS & ROUBOS").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    'Certifica-se que os dados comecem na linha 2
    If UltimaLinha < 8 Then UltimaLinha = 8
    'Seleciona a aba Pedidos
    Sheets("PERDAS & ROUBOS").Select
       'Seleciona a célula A1
    Range("A1").Select
    'Volta para a aba Geral
    Sheets("GE").Select
    
    'Laço para percorrer todas as abas
    For j = 1 To Sheets.Count
        'Verifica o nome das abas e exclui as que não interessam
        If Sheets(j).Name <> "GE" And Sheets(j).Name <> "Planilha" And Sheets(j).Name <> "Imprimir" And Sheets(j).Name <> "CB" And Sheets(j).Name <> "pedidos" And Sheets(j).Name <> "C & C" And Sheets(j).Name <> "V & L" And Sheets(j).Name <> "EVOL." And Sheets(j).Name <> "V. IND" And Sheets(j).Name <> "EST" And Sheets(j).Name <> "recibo" And Sheets(j).Name <> "CAD." And Sheets(j).Name <> "VENDAS A PRAZO" And Sheets(j).Name <> "PERDAS & ROUBOS" And Sheets(j).Name <> "FOR." And Sheets(j).Name <> "PR E ESTQ" And Sheets(j).Name <> "HISTORICO" And Sheets(j).Name <> "FORNECEDORES" And Sheets(j).Name <> "121P" And Sheets(j).Name <> "122P" And Sheets(j).Name <> "123P" And Sheets(j).Name <> "124P" And Sheets(j).Name <> "125P" And Sheets(j).Name <> "ImprimirPRE" And Sheets(j).Name <> "reciboPRE" And Sheets(j).Name <> "EVOL2" And Sheets(j).Name <> "CB" Then
            'Seleciona a aba que interessa
            Sheets(j).Select
            'Pega a última linha com dados da aba ativa pela coluna A
            UltimaLinha = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
            'Certifica-se que os dados comecem na linha 4
            If UltimaLinha < 8 Then UltimaLinha = 8
            'Laço para percorrer todas as linhas da planilha ativa
            For i = 9 To UltimaLinha
                'Verifica se a coluna D contém alguma coisa
                If Range("R" & i).Value <> "" Then
                    'Copia os dados para a aba Pedidos
                    Sheets("PERDAS & ROUBOS").Range("F" & Linha).Value = ActiveSheet.Name
                    Sheets("PERDAS & ROUBOS").Range("H" & Linha).Value = ActiveSheet.Range("Q" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("I" & Linha).Value = ActiveSheet.Range("R" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("J" & Linha).Value = ActiveSheet.Range("S" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("G" & Linha).Value = ActiveSheet.Range("J4").Value
                    'Incrementa a linha da aba Pedidos
                    Linha = Linha + 1
                End If
            Next
        End If
    Next
    'Exibe mensagem de sucesso
    MsgBox "GERADO RELATÓRIO DE DEFEITOS!", vbDefaultButton1, "DEFEITOS"
    'Volta para a aba Geral
    Sheets("PERDAS & ROUBOS").Select
    'Volta a habilitar as atualizações de tela
    Application.ScreenUpdating = True
End Sub

ai esse codigo que voce mandou utilizando o de defeito seria apenas a linha

wks.Range("M9:0"  & ultimalinha).ClearContents

e eu tentei por ele em varios cantos pra testar e so da erro de depuracao, eu substitui o range do ultima linha e acrescentei e sempre da erro de depuração.. :/

Postado : 25/05/2018 9:09 am

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

Não da pra centralizar essas 20 guias?

Eu nao consegui entender onde os dados devem ser copiados e colados.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 25/05/2018 9:48 am

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

bem como nao consegui fazer em uma unica macro sao dois macros que vai passar pelas abas de 100 a 120 e vai colar na aba de Perdas e roubos.

No caso um código verifica se tem dados em na coluna R de cada aba de 100 a 120 a partir da linha 8 e copia as colunas Q,R,S e a celula J4 (que é onde fica o nome da empresa), e vai colar na aba perdas e roubos nas coluanas H, I, J, e a celula do j4 na coluna G e claro ele também copia o nome da aba e cola na coluna F.

No outro código verifica se tem dados na coluna N a partir da linha 8 e se tiver vai copiar as colunas M,N e O e a celula j4 (que é onde fica o nome da empresa), e vai colar na aba perdas e roubos nas coluanas C D e E e o j4 nesse cola na coluna G. A celula do nome da planilha vai na coluna A.

até aí ele faz tudo de boa cada botao copia os dados das abas de 100 a 120 e cola no seu canto na aba perdas e roubos porém ele sempre substitui os dados colados e no caso ele teria que continuar de onde tiver em branco a ultima linha.

por fim fiz uma macro cleardados só para apagar os dados das abas 100 a 120 para que depois eu digite novos dados e quando apertar no botao ele ir colando na aba perdas e roubos.

a questoa é só pra ele nao apagar (substituir) os dados que já possuem na aba Perdas e Roubos.
é isso...

Postado : 25/05/2018 7:10 pm

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

Cara agora eu entendi menos!! :shock: :shock:

Se vc vai digitar nas guias de 100 a 120 para depois copiar para a percas e roubos e depois da copia apagar os dados das planilhas de 100 a 120.

A pergunta que vale R$ 1.000.000,00 é:

Pq nao digitar direto na guia percas e roubos?

Eu pessoalmente faria o contrario, digitaria tudo em percas e roubos e se necessario for separaria por loja posteriormente.

É mais facil separar do que juntar.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 26/05/2018 4:22 pm

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

olá kkkk vou lhe responder a pergunta de R$ 1.000.000,00. As lojas as vezes cancelam e quando cancelam tem um botao la que apaga tudo dos historicos das abas precisa ser assim ai vai tudo embora das abas que ficam de 100 a 120, la em perdas e roubos os dados continuariam para consultas posteriores. Além disso, nas abas eu não posso exceder determinadas quantidades de linhas, por ter ter outros dados mais abaixo, cada aba (100 a 120) vai suportar a inclusão de até 12 linhas perdios ou roubados, depois disso terei que apagar para colocar novos dados, esses casos sao para casos de lojas que duram mais tempo. e lá na aba perdas e roubos a quantidades de linha será infinita, além de eu ter uma visão macro de furtos e roubos ao todo. inicialmente ele precisa estar na aba da loja facilita na hora da inclusão dos dados eu fazendo isso já com a aba aberta. Na verdade os codigos que eu fiz separado deu certo, o unico problema em questao é que ele ta substituindo os dados ao invés de ele ir colando nas linhas que estiverem em branco.

Pra finalizar sua dúvida, se eu digitar em perdas e roubos muitos dados e for fazer o processo inverso como você fala além de ultrapassar as 12 linhas ele também poderia colocar informacoes em abas que ja sao de outras lojas.

Postado : 27/05/2018 4:12 pm

kayomaster

(@kayomaster)

Posts: 90

Trusted Member

Topic starter

olá será que não teria como apenas acrescentar essa alteração nos codigos. por exemplo da rotina só colar quando a linha da coluna B tiver vazia em perdas e roubos para o codigo de Sub Relatoriodederoubos() e a linha da coluna I em branco quando for o codigo Sub Relatoriodededefeitos()
porque o resto ja ta tudo pronto so ta faltando isso...

link drive https://drive.google.com/open?id=1anTG7 ... Bf87exUD1A

Sub Relatoriodederoubos()
    '=========================================================================================
    'Código VBA desenvolvido por Wagner Morel, em 15/07/2017, para kayomaster, integrante do _
    do fórum planilhando, para Gerar relatório de Pedido dos Mercadinhos
    '=========================================================================================
    'Declaração de variáveis
    Dim i As Long
    Dim j As Long
    Dim UltimaLinha As Long
    Dim Linha As Long
    
    'Desabilita atualizações de tela
    Application.ScreenUpdating = False
    
    'Atribui a linha 3 como sendo a primeira da aba Pedidos
    Linha = 4
    
    'Limpa a aba Pedidos
    'Pega a última linha com dados da aba Pedidos pela coluna A
    UltimaLinha = Sheets("PERDAS & ROUBOS").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    'Certifica-se que os dados comecem na linha 2
    If UltimaLinha < 8 Then UltimaLinha = 8
    'Seleciona a aba Pedidos
    Sheets("PERDAS & ROUBOS").Select
       'Seleciona a célula A1
    Range("A1").Select
    'Volta para a aba Geral
    Sheets("GE").Select
    
    'Laço para percorrer todas as abas
    For j = 1 To Sheets.Count
        'Verifica o nome das abas e exclui as que não interessam
        If Sheets(j).Name <> "GE" And Sheets(j).Name <> "Planilha" And Sheets(j).Name <> "Imprimir" And Sheets(j).Name <> "CB" And Sheets(j).Name <> "pedidos" And Sheets(j).Name <> "C & C" And Sheets(j).Name <> "V & L" And Sheets(j).Name <> "EVOL." And Sheets(j).Name <> "V. IND" And Sheets(j).Name <> "EST" And Sheets(j).Name <> "recibo" And Sheets(j).Name <> "CAD." And Sheets(j).Name <> "VENDAS A PRAZO" And Sheets(j).Name <> "PERDAS & ROUBOS" And Sheets(j).Name <> "FOR." And Sheets(j).Name <> "PR E ESTQ" And Sheets(j).Name <> "HISTORICO" And Sheets(j).Name <> "FORNECEDORES" And Sheets(j).Name <> "121P" And Sheets(j).Name <> "122P" And Sheets(j).Name <> "123P" And Sheets(j).Name <> "124P" And Sheets(j).Name <> "125P" And Sheets(j).Name <> "ImprimirPRE" And Sheets(j).Name <> "reciboPRE" And Sheets(j).Name <> "EVOL2" And Sheets(j).Name <> "CB" Then
            'Seleciona a aba que interessa
            Sheets(j).Select
            'Pega a última linha com dados da aba ativa pela coluna A
            UltimaLinha = Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
            'Certifica-se que os dados comecem na linha 4
            If UltimaLinha < 8 Then UltimaLinha = 8
            'Laço para percorrer todas as linhas da planilha ativa
            For i = 9 To UltimaLinha
                'Verifica se a coluna D contém alguma coisa
                If Range("N" & i).Value <> "" Then
                    'Copia os dados para a aba Pedidos
                    Sheets("PERDAS & ROUBOS").Range("A" & Linha).Value = ActiveSheet.Name
                    Sheets("PERDAS & ROUBOS").Range("C" & Linha).Value = ActiveSheet.Range("M" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("D" & Linha).Value = ActiveSheet.Range("N" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("E" & Linha).Value = ActiveSheet.Range("O" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("B" & Linha).Value = ActiveSheet.Range("J4").Value
                    'Incrementa a linha da aba Pedidos
                    Linha = Linha + 1
                End If
            Next
        End If
    Next
    'Exibe mensagem de sucesso
    MsgBox "GERADO RELATÓRIO DE FALTAS (ROUBOS)!", vbDefaultButton1, "PRODUTOS FALTANDO"
    'Volta para a aba Geral
    Sheets("PERDAS & ROUBOS").Select
    'Volta a habilitar as atualizações de tela
    Application.ScreenUpdating = True
End Sub


Sub Relatoriodededefeitos()
    '=========================================================================================
    'Código VBA desenvolvido por Wagner Morel, em 15/07/2017, para kayomaster, integrante do _
    do fórum planilhando, para Gerar relatório de Pedido dos Mercadinhos
    '=========================================================================================
    'Declaração de variáveis
    Dim i As Long
    Dim j As Long
    Dim UltimaLinha As Long
    Dim Linha As Long
    
    'Desabilita atualizações de tela
    Application.ScreenUpdating = False
    
    'Atribui a linha 3 como sendo a primeira da aba Pedidos
    Linha = 4
    
    'Limpa a aba Pedidos
    'Pega a última linha com dados da aba Pedidos pela coluna A
    UltimaLinha = Sheets("PERDAS & ROUBOS").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    'Certifica-se que os dados comecem na linha 2
    If UltimaLinha < 8 Then UltimaLinha = 8
    'Seleciona a aba Pedidos
    Sheets("PERDAS & ROUBOS").Select
       'Seleciona a célula A1
    Range("A1").Select
    'Volta para a aba Geral
    Sheets("GE").Select
    
    'Laço para percorrer todas as abas
    For j = 1 To Sheets.Count
        'Verifica o nome das abas e exclui as que não interessam
        If Sheets(j).Name <> "GE" And Sheets(j).Name <> "Planilha" And Sheets(j).Name <> "Imprimir" And Sheets(j).Name <> "CB" And Sheets(j).Name <> "pedidos" And Sheets(j).Name <> "C & C" And Sheets(j).Name <> "V & L" And Sheets(j).Name <> "EVOL." And Sheets(j).Name <> "V. IND" And Sheets(j).Name <> "EST" And Sheets(j).Name <> "recibo" And Sheets(j).Name <> "CAD." And Sheets(j).Name <> "VENDAS A PRAZO" And Sheets(j).Name <> "PERDAS & ROUBOS" And Sheets(j).Name <> "FOR." And Sheets(j).Name <> "PR E ESTQ" And Sheets(j).Name <> "HISTORICO" And Sheets(j).Name <> "FORNECEDORES" And Sheets(j).Name <> "121P" And Sheets(j).Name <> "122P" And Sheets(j).Name <> "123P" And Sheets(j).Name <> "124P" And Sheets(j).Name <> "125P" And Sheets(j).Name <> "ImprimirPRE" And Sheets(j).Name <> "reciboPRE" And Sheets(j).Name <> "EVOL2" And Sheets(j).Name <> "CB" Then
            'Seleciona a aba que interessa
            Sheets(j).Select
            'Pega a última linha com dados da aba ativa pela coluna A
            UltimaLinha = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
            'Certifica-se que os dados comecem na linha 4
            If UltimaLinha < 8 Then UltimaLinha = 8
            'Laço para percorrer todas as linhas da planilha ativa
            For i = 9 To UltimaLinha
                'Verifica se a coluna D contém alguma coisa
                If Range("R" & i).Value <> "" Then
                    'Copia os dados para a aba Pedidos
                    Sheets("PERDAS & ROUBOS").Range("F" & Linha).Value = ActiveSheet.Name
                    Sheets("PERDAS & ROUBOS").Range("H" & Linha).Value = ActiveSheet.Range("Q" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("I" & Linha).Value = ActiveSheet.Range("R" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("J" & Linha).Value = ActiveSheet.Range("S" & i).Value
                    Sheets("PERDAS & ROUBOS").Range("G" & Linha).Value = ActiveSheet.Range("J4").Value
                    'Incrementa a linha da aba Pedidos
                    Linha = Linha + 1
                End If
            Next
        End If
    Next
    'Exibe mensagem de sucesso
    MsgBox "GERADO RELATÓRIO DE DEFEITOS!", vbDefaultButton1, "DEFEITOS"
    'Volta para a aba Geral
    Sheets("PERDAS & ROUBOS").Select
    'Volta a habilitar as atualizações de tela
    Application.ScreenUpdating = True
End Sub


Sub fncCLEARPERDASEROUBOS()
  Dim wks As Excel.Worksheet
  
  For Each wks In Sheets
    Select Case wks.Name
      Case "MAT.", "100", "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "111", "112", "113", "114", "115", "116", "117", "118", "119", "120"
        wks.Range("M9:020").ClearContents
        wks.Range("Q8:S20").ClearContents
        
        End Select
  Next wks
End Sub

:?: :!: