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,651 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

(@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

(@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

(@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