Várias planilhas usando a mesma macro

Question

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.

Answer 1

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.

Answer 2

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

Answer 3

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

Answer 4

[e-mail]

---

Anderson Diniz [e-mail]

Answer 5

---

Anderson Diniz [e-mail]

Answer 6

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.

Answer 7

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 [e-mail]

Answer 8

Bom dia Anderson,

Certíssimo agora.

Muito Obrigado.

Bom trabalho!

---

Marco Antonio.

Answer 9

Favor marcar como respondido

---

Anderson Diniz [e-mail]