Excel VBA Copiar

Question

Boas sou um novato em VBA

Sou comercial e estou a construir a minha base de dados em excel base essa que para já tem Clientes, notas de encomenda e é aqui que está o meu primeiro de muistos problemas.

Vamos lá então ver se eu me explico como deve ser: Construi um form em excel para colocar a minha encomenda em que depois de finalizar a introdução de todos os artigos, gostaria de guardar essa mesma encomenda em outra folha do excel com(NomeCliente;Os Artigos,Quantidades,etc...) são algumas celulas que eu gostava de copiar através do VBA.

Obrigado desde já se eu não me expliquei bem por favor digam para tentar de outra formula.

Answer 1

Tente algo do tipo:

Private Sub CommandButton1_Click()
  
  Dim ws As Worksheet
  
  Set ws = Sheets.Add
  
  With ws
    'Conteúdo do TextBox1:
    .Range("B3") = TextBox1

    'Conteúdo do TextBox1:
    .Range("B5") = TextBox2

    'Conteúdo do TextBox1:
    .Range("B7") = TextBox3
  End With
  
  Unload Me
  
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Boas Filipe

Pelos vistos não me expliquei nada bem.

Vou tentar melhor, numa folha(Encomendas) eu coloco os produtos que o meu cliente compra.

Esta folha tem procv e muito mais formulas, o que eu fiz foi numa parte da folha que comessa em A59

o dito formulário na propria folha fica desta formula para ser copiado.

 

Nº Enc.	Data	Tipo	Nº Cliente	Estabelecimento	Localidade	Freguesia	Desc. Com.	Desc. Fin.
	Cód.	Categoria	Descrição Produto	Preço	Qunt.	Litros	Desc.%	Comissão	Total
0001/11	06-12-2010	Retalho	98	F.Canelas	Alhos Vedros	0	0,00%	0,00%
	OL01	Vinho	OLARIA BAG IN BOX 5 Lts - TINTO	6,30 €	2	10,00 L		0,16 €	12,60 €
	rd02	Vinho	REGUENGOS DOC 6X0,75 - TINTO	11,20 €	1	04,50 L		0,14 €	11,20 €
	rd02	Vinho	REGUENGOS DOC 6X0,75 - TINTO	11,20 €	1	04,50 L		0,14 €	11,20 €
	rd03	Vinho	REGUENGOS DOC 20X0,375 - TINTO	24,54 €	1	07,50 L		0,31 €	24,54 €
	rd04	Vinho	REGUENGOS DOC 12X0,75 - BRANCO	22,40 €	1	09,00 L		0,28 €	22,40 €
	rd05	Vinho	REGUENGOS DOC 6X0,75 - BRANCO	11,20 €	1	04,50 L		0,14 €	11,20 €
	tr01	Vinho	TERRAS D`EL REI 12X1 LITRO - TINTO	23,83 €	1	12,00 L		0,30 €	23,83 €
	tr02	Vinho	TERRAS D`EL REI 12X0,75 - TINTO	17,82 €	1	09,00 L		0,22 €	17,82 €
	tr03	Vinho	TERRAS D`EL REI 6X0,75 - TINTO	8,91 €	1	04,50 L		0,11 €	8,91 €
	tr04	Vinho	TERRAS D`EL REI 20X0,375 - TINTO	21,81 €	1	07,50 L		0,27 €	21,81 €
	tr05	Vinho	TERRAS D`EL REI 12X1 LITRO - BRANCO	23,83 €	1	12,00 L		0,30 €	23,83 €
	tr06	Vinho	TERRAS D`EL REI 12X0,75 - BRANCO	17,82 €	1	09,00 L		0,22 €	17,82 €
				Totais:	13	94,00 L		2,59 €	207,16 €

Agora gostava de com um botão elecopiar tudo isto para a folha(Encomendas_2011).

Onde depois vem mais problemas mas cada um a seu tempo anão que queiras que eu te diga quais os problemas:

Francisco

Answer 3

Use o código abaixo. Estou considerando que a coluna B possui a descrição Data/Cód conforme seu exemplo, e que seus dados começam na linha 4:

Sub CopiaPlanilha()
  
  Dim rLast As Long
  
  'Atribui a rLast a última linha da Planilha
  rLast = Cells(Rows.Count, "B").End(xlUp).Row
  
  Rows("4:" & rLast).Copy Destination:=Sheets("Encomendas_2011").Rows(4)
  
End Sub

 

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 4

Boas

Vou tentar depois digo algo mas terei de alterar algo porque os dados não começam na linha 4

 

Abraço

Até já

Answer 5

Boas

Optimo obrigado já exprimentei e copia mas aconteçe que ao copiar devia de (copiar especial valores).

Depois na folha de Encomendas_2011 a macro devia de procurar tambem a ultima linha da prenchida para ir colocando as outras encomendas.

Por fim a minha nota de encomenda contem 12 linhas onde coloco os produtos, mas nem sempre eu preencho essas 12 linhas, será que é possivel eleminar essas linhas?

Obrigado desde já

Answer 6

Para resolver o primeiro e o segundo problema, adapte o código abaixo:

Sub CopiaPlanilha()
 
 Dim rLast1 As Long
 Dim rLast2 As Long
 
 rLast1 = Cells(Rows.Count, "B").End(xlUp).Row
 rLast2 = Sheets("Encomendas_2011").Cells(Rows.Count, "C").End(xlUp).Row + 1
 
 Rows("4:" & rLast1).Copy
 Sheets("Encomendas_2011").Rows(rLast2).PasteSpecial Paste:=xlPasteValues
 
End Sub

Não entendi muito bem o terceiro problema. Para apagar 12 linhas de uma Planilha, você pode usar o código abaixo:

Sub ApagaLinhasNotaEncomenda()
  Sheets("NotasEncomenda").Rows("1:12").Delete
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 7

Boas

Desde já obrigado vou exprimentar depois digo.

Em relação ao terceiro problema é o seguinte:

Como disse tenho 12 linhas onde posso colocar os produtos que o cliente compra mas o cliente nem sempre compra esses 12 produtos.

Seponhamos o seguinte o cliente compra 3 produtos difrentes sobram 9 linhas e eu queria apagalas porque no fim tenho os totais e esses tem de estar presentes sempre de cada encomenda como tabela acima.

Obrigado desde já está a ser uma grande ajuda gostava de ter esta parte pronta antes do final do ano para começar a facturar já com este meu pequeno sistema de vendas.

Answer 8

Boas

Mais uma vez obrigado está optimo.

Mas a primeira macro copiava o formato das celulas e esta não, desculpa a primeira estava melhor a nivel de estetica mas é quase isto que eu quero.

Obrigado

Answer 9

"Optimo obrigado já exprimentei e copia mas aconteçe que ao copiar devia de (copiar especial valores)."

Eu fiz que a macro colasse especial valores porque você pediu. Se quiser voltar e colar preservando a formatação, use:

Rows("4:" & rLast1).Copy Destination:=Sheets("Encomendas_2011").Rows(rLast2)

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 10

Boas

Não como estava está bem eu só gostava que já viesse com as bordas pintadas como está na folha encomenda.

E quanto ao outro problema achas que é possivel?

Obrigado

Answer 11

Boas

Desculpa esta ultima macro está uma beleza.

Agora gostava de eliminar as linhas que ficam em branco, será que é possivel?

Borigado e desculpa mais uma vez, não estava a perceber.

Answer 12

Para eliminar as linhas que ficam em branco:

Sub EliminaVazias()

  Dim r As Long
  Dim rngrow As Range
  
  For r = 8 To 1 Step -1
    Set rngrow = Sheets("Plan1").Rows(r)
    If WorksheetFunction.CountA(Sheets("Plan1").Rows(r)) = 0 Then
      rngrow.EntireRow.Delete
    End If
  Next r
      
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 13

Até aqui a macro está da seguinte forma:

Private Sub Btn_Guardar_Encomenda_Click()
 
  Dim rLast1 As Long
 Dim rLast2 As Long
 
 rLast1 = Cells(Rows.Count, "J").End(xlUp).Row
 rLast2 = Sheets("Encomendas_2011").Cells(Rows.Count, "C").End(xlUp).Row + 1

 
Rows("57:" & rLast1).Copy Destination:=Sheets("Encomendas_2011").Rows(rLast2)
 
 Rows("57:" & rLast1).Copy
 Sheets("Encomendas_2011").Rows(rLast2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 

End Sub

E está uma beleza aora esta acima não sei como fazer podes explicar?

Obrigado

Answer 14

-Substitue Plan1 pela Planilha que deseja eliminar as linhas em branco.

-O exemplo apaga das linhas 8 até 1. Adapte para suas necessidades.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 15

Boas

Coloquei como tu dizes e não aconteçe nada porque será o que eu estou a faze de errado?

A macro está assim:

Private Sub Btn_Guardar_Encomenda_Click()
 
  Dim rLast1 As Long
  Dim rLast2 As Long
  Dim r As Long
  Dim rngrow As Range

 
 
 rLast1 = Cells(Rows.Count, "J").End(xlUp).Row
 rLast2 = Sheets("Encomendas_2011").Cells(Rows.Count, "J").End(xlUp).Row + 1
 
 
Rows("102:" & rLast1).Copy Destination:=Sheets("Encomendas_2011").Rows(rLast2)
 
Rows("102:" & rLast1).Copy
 Sheets("Encomendas_2011").Rows(rLast2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
 
 For r = 8 To 1 Step -1
    Set rngrow = Sheets("Encomendas_2011").Rows(r)
    If WorksheetFunction.CountA(Sheets("Encomendas_2011").Rows(r)) = 0 Then
      rngrow.EntireRow.Delete
    End If
  Next r

 
 
End Sub

Answer 16

Estou desconfiado que você não alterou os parâmetros 8 e 1 do loop For. Experimente, ao invés de

For r = 8 To 1 Step -1

utilizar

For r = 500 To 1 Step -1

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 17

Fiz o que disses-te e nada aconteceu.

Repara antes desta ultima macro na minha folha de "Encomendas_2011" a minha nota de encomenda ficava assim e eu queria que esta ultima macro apagasse as linhas em branco, mas não está a acontecer.

0002/11	17-12-2010	Retalho	10	Md. Abdul Ahad Khan	Conde Redondo	Coração de Jesus	5,00%	0,00%
	mp01	Vinho	MONSARAZ PREMIUM 3X0,75 - TINTO	45,01 €	1	02,25 L		1,13 €	45,01 €
				Totais:	1	02,25 L		1,07 €	42,76 €

Answer 18

Nesse caso, gostaria que disponibilizasse sua Pasta de Trabalho para que possamos analisar.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 19

OK mas está no inicio ainda e olha que na folha de "Encomendas_2011" ainda vou querer mais umas coisas, como por exemplo gostaria de colocar mais algo como vés abaixo dessa encomenda para ser copiado para "Relatório_Vendas".

Mas vou devagar pois já reparei que ao copiar a encomenda copio tudo o que está abaixo dela mas eu gostava de só copiar a encomenda.

Ai vai o link. http://www.4shared.com/dir/PwQz9ePo/sharing.html

Obrigado desde já pela atenção prestada

Answer 20

Na verdade, as células das linhas estavam preenchidas com conteúdo "" (vazio). A rotina abaixo corrige essa situação:

Sub EliminaVazias()

  Dim r As Long
  Dim rng As Range
  
  With Sheets("Encomendas_2011")
    For r = 15 To 4 Step -1
      Set rng = .Cells(r, "B")
      If rng = vbNullString Then
        rng.EntireRow.Delete
      End If
    Next r
  End With

End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 21

Coloquei como disses-te a primeira vez que eu clico no botão guardar está otimo mas depois guardando mais encomendas não fica correcto, eu mudei rng para a coluna E pois eu necessito tambem dos valores.

Estou a fazer alguma coisa mal?

Obrigado

Answer 22

Com o código que eu adaptei, como está sua nova rotina?

O que significa que após tentar novamente "não fica correcto"? A rotina pára de apagar linhas? Perde-se a formatação?

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 23

A rotina pára de apagar as linhas

Private Sub Btn_Guardar_Encomenda_Click()
 
 Dim rLast1 As Long
 Dim rLast2 As Long
 Dim r As Long
 Dim rng As Range
  
 
 rLast1 = Cells(Rows.Count, "J").End(xlUp).Row
 rLast2 = Sheets("Encomendas_2011").Cells(Rows.Count, "J").End(xlUp).Row + 1
 
 
Rows("102:" & rLast1).Copy Destination:=Sheets("Encomendas_2011").Rows(rLast2)
 
Rows("102:" & rLast1).Copy
 Sheets("Encomendas_2011").Rows(rLast2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
 
 
 With Sheets("Encomendas_2011")
  For r = 15 To 4 Step -1
   Set rng = .Cells(r, "E")
   If rng = vbNullString Then
    rng.EntireRow.Delete
   End If
  Next r
 End With
  
End Sub

o código é este acima.

Answer 24

Você esqueceu de trocar

 

For r = 15 To 4 Step -1

por

For r = 102 To 4 Step -1

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 25

Excelente, optimo está tal eu gostava.

Muito e muito obrigado pelo tempo despendido.

Mas só uma pergunta qual a razão de ter de ser o 102?

Bom é certo que se não te importares eu gostava de mais umas coisas para este mesmo botão.

Será que posso pedinchar?

Abraços e muito, muito obrigado

Answer 26

É feito um loop da linha 102 até a 4. Logo, a rotina anterior não executava a ação desejada porque verificava se apagava linhas apenas das linhas 15 até a 4.

Se tem mais perguntas, abra um novo tópico nesse mesmo fórum, pois este já está solucionado.

Pode ser que eu mesmo te ajude no novo tópico. Faz-se isso para manter a organização dos fóruns.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br