none
Várias planilhas usando a mesma macro RRS feed

  • Pergunta

  • Prezados,

    Prezados possuo uma macro em um arquivo que copia os dados de uma planilha ("Vendas") e cola sequencialmente numa outra planilha ("Relatório").

    Preciso criar vários outras planilhas de de vendas idênticas à primeira "Vendas", exemplo: "Vendas2", "Vendas3", "Vendas4"....

    Contudo que ao usar o botão "gravar" nestas planilhas as informações todas fossem acumulando na planilha "Relatório" (que seria apenas uma única planilha).

    A macro que uso e funciona bem (porém somente busca os dados numa única planilha "Vendas" é este:

     

    Sub Gravar_Vendas()

    Application.ScreenUpdating = False
    Dim Data As Date
    Dim Horario As Double
    Dim Atendente As Integer
    Dim NPedido As Double
    Dim NCodigo As Double
    Dim Descr As String
    Dim Unidade As String
    Dim quant As Integer
    Dim Desc As Double
    Dim Preco As Double
    Dim Total As Double
    Dim UltimaCel As Integer

    Dim QuantDados As Integer
    Dim Linha As Integer

    QuantDados = Sheets("Vendas").Range("E42").End(xlUp).Row
    Linha = 17
    While Linha < QuantDados + 1

    Sheets("Vendas").Select
     Data = Range("K7").Value
     Horario = Range("K9").Value
     NPedido = Range("K13").Value
     Atendente = Range("F7").Value
     NCodigo = Range("E" & Linha).Value
     Descr = Range("F" & Linha).Value
     Unidade = Range("G" & Linha).Value
     quant = Range("H" & Linha).Value
     Desc = Range("I" & Linha).Value
     Preco = Range("J" & Linha).Value
     Total = Range("K" & Linha).Value

    Sheets("Relatório").Select

    UltimaCel = Range("D65000").End(xlUp).Row + 1

    Range("D" & UltimaCel).Value = Data
    Range("E" & UltimaCel).Value = Horario
    Range("F" & UltimaCel).Value = Atendente
     Range("G" & UltimaCel).Value = NPedido
     Range("H" & UltimaCel).Value = NCodigo
     Range("I" & UltimaCel).Value = Descr
     Range("j" & UltimaCel).Value = Unidade
     Range("K" & UltimaCel).Value = quant
     Range("L" & UltimaCel).Value = Desc
     Range("M" & UltimaCel).Value = Preco
     Range("N" & UltimaCel).Value = Total
     Linha = Linha + 1
    Wend

    Sheets("Vendas").Select
    Range("K13").Value = Range("K13").Value + 1


    MsgBox "Gravado com sucesso"

    Application.ScreenUpdating = True
    End Sub

    Peço que se possível me enviar, caso consiga, os códigos prontos para que eu possa copiar e colar em cada planilha individualmente.

    Abraço.


    Marco Antonio.

    segunda-feira, 30 de outubro de 2017 20:13

Respostas

  • Bom dia Anderson,

    Perguntas:

    1) Ao copiar os códigos acima que você me enviou eu necessito fazer alguma alteração, alguma adapatação?Exemplo: mudar algum nome de planilha, célula, etc?

    2) Eu devo colar os códigos dentro de cada planilha "Vendas". Exemplo: "Vendas2", "Vendas3" etc

    3) A planilha "Relatório" (onde irá receber todas as informações das planilhas "Vendas") pode continuar sem alteração.

    Muito obrigado.

    Marco.



    Marco Antonio.

    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 12:26
  • Bom dia Anderson,

    Perguntas:

    1) Ao copiar os códigos acima que você me enviou eu necessito fazer alguma alteração, alguma adapatação?Exemplo: mudar algum nome de planilha, célula, etc?

    2) Eu devo colar os códigos dentro de cada planilha "Vendas". Exemplo: "Vendas2", "Vendas3" etc

    3) A planilha "Relatório" (onde irá receber todas as informações das planilhas "Vendas") pode continuar sem alteração.

    Muito obrigado.

    Marco.



    Marco Antonio.

    1 - Não

    2 -  Coloque em um módulo

    3 - Sim


    Anderson Diniz


    • Editado AndersonFDiniz2 terça-feira, 31 de outubro de 2017 13:48
    • Sugerido como Resposta AndersonFDiniz2 terça-feira, 31 de outubro de 2017 13:49
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 13:35
  • Option Explicit
    
    Sub chamarGravarVendas()
    Dim pl As Object
    'Para cada planilha nesta pasta de trabalho
    For Each pl In ThisWorkbook.Sheets
    'se a parte esquerda do nome da planilha for Vendas
    If UCase(Left(pl.Name, 6)) = UCase("Vendas") Then
    
    'Chamar o procedimento Gravar_vendas
    Call Gravar_Vendas(pl.Name)
    End If
    
    
    Next pl
    
    MsgBox "Gravado com sucesso"
    
    End Sub
    
    Sub Gravar_Vendas(ByVal nome As String)
    
    Application.ScreenUpdating = False
    Dim Data As Date
    Dim Horario As Double
    Dim Atendente As Integer
    Dim NPedido As Double
    Dim NCodigo As Double
    Dim Descr As String
    Dim Unidade As String
    Dim quant As Integer
    Dim Desc As Double
    Dim Preco As Double
    Dim Total As Double
    Dim UltimaCel As Integer
    
    Dim QuantDados As Integer
    Dim Linha As Integer
    
    QuantDados = Sheets(nome).Range("E42").End(xlUp).Row
    Linha = 17
    While Linha < QuantDados + 1
    
    Sheets(nome).Select
     Data = Range("K7").Value
     Horario = Range("K9").Value
     NPedido = Range("K13").Value
     Atendente = Range("F7").Value
     NCodigo = Range("E" & Linha).Value
     Descr = Range("F" & Linha).Value
     Unidade = Range("G" & Linha).Value
     quant = Range("H" & Linha).Value
     Desc = Range("I" & Linha).Value
     Preco = Range("J" & Linha).Value
     Total = Range("K" & Linha).Value
    
    Sheets("Relatório").Select
    
    UltimaCel = Range("D65000").End(xlUp).Row + 1
    
    Range("D" & UltimaCel).Value = Data
    Range("E" & UltimaCel).Value = Horario
    Range("F" & UltimaCel).Value = Atendente
     Range("G" & UltimaCel).Value = NPedido
     Range("H" & UltimaCel).Value = NCodigo
     Range("I" & UltimaCel).Value = Descr
     Range("j" & UltimaCel).Value = Unidade
     Range("K" & UltimaCel).Value = quant
     Range("L" & UltimaCel).Value = Desc
     Range("M" & UltimaCel).Value = Preco
     Range("N" & UltimaCel).Value = Total
     Linha = Linha + 1
    Wend
    
    Sheets(nome).Select
    Range("K13").Value = Range("K13").Value + 1
    
    
    
    
    Application.ScreenUpdating = True
    End Sub
    


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 terça-feira, 31 de outubro de 2017 13:49
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 13:45

  • Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 terça-feira, 31 de outubro de 2017 15:24
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 15:24
  • Boa tarde Anderson,

    Fiz tudo com você falou. E deu certo quase tudo.

    Há somente um problema:

    Tenho no arquivo exemplo 3 planilhas (Vendas, Vendas2, vendas3) e 1 planilha (Relatório).

    Quando uso individualmente qualquer das três planilhas "Vendas" e clico em gravar, as informações da planilha vendas vão para a planilha "Relatório" do jeito que quero, porém vão também as informações das planilhas "Vendas2" e "Vendas3".

    Ou seja, qualquer das três planilhas que uso quando clico em "Gravar" passa para planilha "Relatório" os dados das três planilhas de Vendas simultanemente.

    Posso mandar o arquivo no seu email? Se tiver algum custo é só falar.

    Abraço.


    Marco Antonio.

    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 19:28
  • Favor marcar como respondido

    Anderson Diniz diniabr2011@gmail.com

    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    quarta-feira, 1 de novembro de 2017 14:07

Todas as Respostas

  • Bom dia Anderson,

    Perguntas:

    1) Ao copiar os códigos acima que você me enviou eu necessito fazer alguma alteração, alguma adapatação?Exemplo: mudar algum nome de planilha, célula, etc?

    2) Eu devo colar os códigos dentro de cada planilha "Vendas". Exemplo: "Vendas2", "Vendas3" etc

    3) A planilha "Relatório" (onde irá receber todas as informações das planilhas "Vendas") pode continuar sem alteração.

    Muito obrigado.

    Marco.



    Marco Antonio.

    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 12:26
  • Bom dia Anderson,

    Perguntas:

    1) Ao copiar os códigos acima que você me enviou eu necessito fazer alguma alteração, alguma adapatação?Exemplo: mudar algum nome de planilha, célula, etc?

    2) Eu devo colar os códigos dentro de cada planilha "Vendas". Exemplo: "Vendas2", "Vendas3" etc

    3) A planilha "Relatório" (onde irá receber todas as informações das planilhas "Vendas") pode continuar sem alteração.

    Muito obrigado.

    Marco.



    Marco Antonio.

    1 - Não

    2 -  Coloque em um módulo

    3 - Sim


    Anderson Diniz


    • Editado AndersonFDiniz2 terça-feira, 31 de outubro de 2017 13:48
    • Sugerido como Resposta AndersonFDiniz2 terça-feira, 31 de outubro de 2017 13:49
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 13:35
  • Option Explicit
    
    Sub chamarGravarVendas()
    Dim pl As Object
    'Para cada planilha nesta pasta de trabalho
    For Each pl In ThisWorkbook.Sheets
    'se a parte esquerda do nome da planilha for Vendas
    If UCase(Left(pl.Name, 6)) = UCase("Vendas") Then
    
    'Chamar o procedimento Gravar_vendas
    Call Gravar_Vendas(pl.Name)
    End If
    
    
    Next pl
    
    MsgBox "Gravado com sucesso"
    
    End Sub
    
    Sub Gravar_Vendas(ByVal nome As String)
    
    Application.ScreenUpdating = False
    Dim Data As Date
    Dim Horario As Double
    Dim Atendente As Integer
    Dim NPedido As Double
    Dim NCodigo As Double
    Dim Descr As String
    Dim Unidade As String
    Dim quant As Integer
    Dim Desc As Double
    Dim Preco As Double
    Dim Total As Double
    Dim UltimaCel As Integer
    
    Dim QuantDados As Integer
    Dim Linha As Integer
    
    QuantDados = Sheets(nome).Range("E42").End(xlUp).Row
    Linha = 17
    While Linha < QuantDados + 1
    
    Sheets(nome).Select
     Data = Range("K7").Value
     Horario = Range("K9").Value
     NPedido = Range("K13").Value
     Atendente = Range("F7").Value
     NCodigo = Range("E" & Linha).Value
     Descr = Range("F" & Linha).Value
     Unidade = Range("G" & Linha).Value
     quant = Range("H" & Linha).Value
     Desc = Range("I" & Linha).Value
     Preco = Range("J" & Linha).Value
     Total = Range("K" & Linha).Value
    
    Sheets("Relatório").Select
    
    UltimaCel = Range("D65000").End(xlUp).Row + 1
    
    Range("D" & UltimaCel).Value = Data
    Range("E" & UltimaCel).Value = Horario
    Range("F" & UltimaCel).Value = Atendente
     Range("G" & UltimaCel).Value = NPedido
     Range("H" & UltimaCel).Value = NCodigo
     Range("I" & UltimaCel).Value = Descr
     Range("j" & UltimaCel).Value = Unidade
     Range("K" & UltimaCel).Value = quant
     Range("L" & UltimaCel).Value = Desc
     Range("M" & UltimaCel).Value = Preco
     Range("N" & UltimaCel).Value = Total
     Linha = Linha + 1
    Wend
    
    Sheets(nome).Select
    Range("K13").Value = Range("K13").Value + 1
    
    
    
    
    Application.ScreenUpdating = True
    End Sub
    


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 terça-feira, 31 de outubro de 2017 13:49
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 13:45
  • diniabr2011@gmail.com

    Anderson Diniz diniabr2011@gmail.com

    terça-feira, 31 de outubro de 2017 14:00

  • Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 terça-feira, 31 de outubro de 2017 15:24
    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 15:24
  • Boa tarde Anderson,

    Fiz tudo com você falou. E deu certo quase tudo.

    Há somente um problema:

    Tenho no arquivo exemplo 3 planilhas (Vendas, Vendas2, vendas3) e 1 planilha (Relatório).

    Quando uso individualmente qualquer das três planilhas "Vendas" e clico em gravar, as informações da planilha vendas vão para a planilha "Relatório" do jeito que quero, porém vão também as informações das planilhas "Vendas2" e "Vendas3".

    Ou seja, qualquer das três planilhas que uso quando clico em "Gravar" passa para planilha "Relatório" os dados das três planilhas de Vendas simultanemente.

    Posso mandar o arquivo no seu email? Se tiver algum custo é só falar.

    Abraço.


    Marco Antonio.

    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    terça-feira, 31 de outubro de 2017 19:28
  • Option Explicit
    
    Sub chamarGravarVendas()
    
    Call Gravar_Vendas("Vendas")
    
    
    MsgBox "Gravado com sucesso"
    
    End Sub
    
    Sub chamarGravarVendas2()
    
    Call Gravar_Vendas("Vendas2")
    
    
    MsgBox "Gravado com sucesso"
    
    End Sub
    
    
    Sub chamarGravarVendas3()
    
    Call Gravar_Vendas("Vendas3")
    
    
    MsgBox "Gravado com sucesso"
    
    End Sub
    
    
    Sub Gravar_Vendas(ByVal nome As String)
    
    Application.ScreenUpdating = False
    Dim Data As Date
    Dim Horario As Double
    Dim Atendente As Integer
    Dim NPedido As Double
    Dim NCodigo As Double
    Dim Descr As String
    Dim Unidade As String
    Dim quant As Integer
    Dim Desc As Double
    Dim Preco As Double
    Dim Total As Double
    Dim UltimaCel As Integer
    
    Dim QuantDados As Integer
    Dim Linha As Integer
    
    QuantDados = Sheets(nome).Range("E42").End(xlUp).Row
    Linha = 17
    While Linha < QuantDados + 1
    
    Sheets(nome).Select
     Data = Range("K7").Value
     Horario = Range("K9").Value
     NPedido = Range("K13").Value
     Atendente = Range("F7").Value
     NCodigo = Range("E" & Linha).Value
     Descr = Range("F" & Linha).Value
     Unidade = Range("G" & Linha).Value
     quant = Range("H" & Linha).Value
     Desc = Range("I" & Linha).Value
     Preco = Range("J" & Linha).Value
     Total = Range("K" & Linha).Value
    
    Sheets("Relatório").Select
    
    UltimaCel = Range("D65000").End(xlUp).Row + 1
    
    Range("D" & UltimaCel).Value = Data
    Range("E" & UltimaCel).Value = Horario
    Range("F" & UltimaCel).Value = Atendente
     Range("G" & UltimaCel).Value = NPedido
     Range("H" & UltimaCel).Value = NCodigo
     Range("I" & UltimaCel).Value = Descr
     Range("j" & UltimaCel).Value = Unidade
     Range("K" & UltimaCel).Value = quant
     Range("L" & UltimaCel).Value = Desc
     Range("M" & UltimaCel).Value = Preco
     Range("N" & UltimaCel).Value = Total
     Linha = Linha + 1
    Wend
    
    Sheets(nome).Select
    Range("K13").Value = Range("K13").Value + 1
    
    
    
    
    Application.ScreenUpdating = True
    End Sub
    
    


    Anderson Diniz diniabr2011@gmail.com

    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 1 de novembro de 2017 02:09
    quarta-feira, 1 de novembro de 2017 02:09
  • Bom dia Anderson,

    Certíssimo agora.

    Muito Obrigado.

    Bom trabalho!


    Marco Antonio.

    quarta-feira, 1 de novembro de 2017 11:18
  • Favor marcar como respondido

    Anderson Diniz diniabr2011@gmail.com

    • Marcado como Resposta Marco1226 terça-feira, 14 de novembro de 2017 18:19
    quarta-feira, 1 de novembro de 2017 14:07