Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Cópia de dados entr...
 
Notifications
Clear all

Cópia de dados entre tabelas

 
2024 - VBA & Macros
Post Recente por francorp 5 anos atrás
7 Posts
2 Usuários
0 Reactions
1,641 Visualizações
RSS
 francorp
(@francorp)
Posts: 4
New Member
Topic starter
 

Bom dia.

Estou tentando usar o código abaixo para copiar linhas que atendem a um critério de uma Excel table para o final de outra excel table em outra pasta.:

A cópia é feita corretamente mas quando vou executar o PasteSpecial (linha em negrito) ocorre o erro "O método PasteSpecial da classe range falhou".

Tentei de várias formas, sempre com o mesmo resultado. Se alguém tem uma dica agradeço muito.

Roberto

Dim tabela As ListObject
Dim newrow As ListRow

ActiveWorkbook.Sheets("Compra").ListObjects("Compra").Range.AutoFilter Field:=7, Criteria1:=">0"
ActiveSheet.ListObjects("Compra").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Histórico").Activate
Set tabela = ActiveSheet.ListObjects("BaseHst")
Set newrow = tabela.ListRows.Add
[b]newrow.Range(1).PasteSpecial xlPasteValues[/b]
Worksheets("Compras").Activate
If ActiveWorkbook.Sheets("Compra").FilterMode = True Then
    ActiveWorkbook.Sheets("Compra").ListObjects("Compra").Range.AutoFilter
End If
End Sub
 
Postado : 11/11/2019 11:16 am
Mauro Coutinho
 Mauro Coutinho
(@coutinho)
Posts: 95
Estimable Member
 

Tente assim

newrow.Range(1).PasteSpecial Paste:=xlPasteValues
 
Postado : 11/11/2019 12:04 pm
 francorp
(@francorp)
Posts: 4
New Member
Topic starter
 

Caro Coutinho.
Obrigado pela ajuda mas, recebia a mesma mensagem: O método PasteSpecial da classe range falhou

 
Postado : 11/11/2019 1:50 pm
Mauro Coutinho
 Mauro Coutinho
(@coutinho)
Posts: 95
Estimable Member
 

francorp, teria como disponibilizar um exemplo resumido com dados ficticios se for o caso, fica mais fácil analisar, uma vez que está utilizando Filtro e compiando as celulas visivei e podemos ter o erro se o destino as celulas não forem iguais, ou talvez ter celula mesclada, dai temos fazer o tratamento.
Use algum drive virtual, tipo o SendSapce e outros e cole o link aqui.

[]s
Mauro Coutinho

 
Postado : 11/11/2019 2:04 pm
 francorp
(@francorp)
Posts: 4
New Member
Topic starter
 

Oi Mauro.

Segue o link para o exemplo.

https://www.dropbox.com/s/kfff8fdivc281 ... .xlsm?dl=0

Obrigado pela ajuda.

Roberto

 
Postado : 12/11/2019 8:51 am
Mauro Coutinho
 Mauro Coutinho
(@coutinho)
Posts: 95
Estimable Member
 

francorp, segue a rotina com a alteração, o que acontecia é que estava copiando os dados no inicio da rotina e quando adiciona nova linha na aba Histórico a ação de Copiar é desfeita e com isso não temos dados a colar temos o erro, eu só inverti a ordem, faça os testes e veja se é isso.

Sub CopyToHist()
Dim tabela As ListObject
Dim newrow As ListRow

ActiveWorkbook.Sheets("Compra").ListObjects("Compra").Range.AutoFilter Field:=7, Criteria1:=">0"
'Eliminamos a ação de copiar no inicio
'ActiveSheet.ListObjects("Compra").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Historico").Activate

Set tabela = ActiveSheet.ListObjects("BaseHst")
Set newrow = tabela.ListRows.Add 'Qdo adiciona nova linha a ação do Copiar é desfeita e com isso temos o erro pois não temos nada a colar

Sheets("Compra").ListObjects("Compra").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
newrow.Range(1).PasteSpecial Paste:=xlPasteValues

    Worksheets("Compra").Activate

If ActiveWorkbook.Sheets("Compra").FilterMode = True Then
    ActiveWorkbook.Sheets("Compra").ListObjects("Compra").Range.AutoFilter
End If

End Sub

[]s
Mauro Coutinho

 
Postado : 12/11/2019 9:36 am
 francorp
(@francorp)
Posts: 4
New Member
Topic starter
 

Funcionou, problema resolvido. Quebrei a cabeça mas não me dei conta disso.

Muito obrigado.

 
Postado : 12/11/2019 12:57 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico