Usuário com melhor resposta
Várias planilhas usando a mesma macro

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 SubPeç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.
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
-
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
-
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
-
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
-
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
-
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
-
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
-
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
-
-
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
-
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
-
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
-
-